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Memorandum to: 
Subject: 



Recipients of IBM 1130 COMMERCIAL SUBROUTINE 
PACKAGE, 1130-SE-25X 

Version 3, Modification Level 1 



The subject program is being forwarded to you with this memorandum. 

Basic program material consists of: 

Application Directory (attached) 

Program Reference Manual (H20-0241-3), TNL N20-1888 

Card deck consisting of object programs and sample problems. 

Refer to Card Deck Key in Application Directory for further 

description. 

Optional program material: 

Source statements and sample problems on one 9 track Distribution 

Tape Reel (DTR) (800 or 1600 bpi, as requested). 

Refer to the Tape Key in the Application Directory for further 

description. 

Any discrepancy between the material received and material ordered, or any 
errors in reproduction, should be reported to the Manager of the Program 
Library providing your programming systems. 
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1130 COMMERCIAL SUBROUTINE PACKAGE 
(1130-SE-25X) Version 3 
APPLICATION DIRECTORY 



This directory contains information concerning all available 
material associated with the subject application. Its objective 
is to enable the recipient to understand what he has received, 
where to locate specific items, and what to do with them. 



CONTENTS 

Documentation Directory 1 

Reference Material 1 

Deck Key — Basic Machine -Readable (Object Decks) 1 

Deck Key — Optional Machine -Readable Material (Source Decks) 4 

Preparatory Systems Procedures 6 

Required Programming Systems 10 

Minimum Machine Configuration 10 

Maintenance Procedures 10 
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DOCUMENTATION DIRECTORY 



Application Description (H20-0520) . This manual contains sufficient information 
to enable the reader to determine whether the application would be useful to him. 
Contents include subroutine specifications and machine configurations. 

Program Reference Manual (H20-0241-3), TNL N20-1888. This manual enables 
the reader to understand and implement the component parts of the application. 
A detailed description of the logical operation of the computer programs asso- 
ciated with the subject is also presented*, The manual is a combined user's, 
operator's and systems manual. Contents include: 

Detailed Description of Each Subroutine 

Sample Problems 

Flowcharts 

Listings 



REFERENCE MATERIAL 



IBM 1130 Computing System Functional Characteristics (A26-5881) . This manual 
describes the IBM 1130 Computing System in detail, at the machine language 
level. 

IBM 1130 Assembler Language (C26-5927) . This publication is intended for 
programmers who have a basic knowledge of the IBM 1130 Computing System. 
It describes the IBM 1130 Assembler language in detail, and includes a full 
description of each type of Assembler statement. 

IBM 1130 Subroutine Library (C26-5929) « This bulletin contains a description 
of each of the IBM- supplied subroutines for conversion, input/ output and 
internal manipulation. 

IBM 1130/1800 Basic FORTRAN IV Language (C26-3715). This manual contains 
the information describing FORTRAN as implemented on the IBM 1130. It is 
necessary to understand the information in this manual in order to use the 1130 
Commercial Subroutine Package. 



DECK KEY -- BASIC MACHINE -READABLE (OBJECT DECKS) 

(NOTES: The underlined name is the name under which the routine has been 
stored. Columns 73-75 contain CSP. ) 
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Description 

//JOB card 

// DUP card 

♦DELETE cards for previous version CSP 

♦STORE card for ADD / SUB 

ADD / SUB object deck 

*STORE card for A1A3 /A3A1 

A1A3 /A3A1 object deck 

♦STORE card for A1DEC 

A1DEC object deck 

♦STORE card for CARRY 

CARRY object deck 

♦STORE card for DECA1 

DECA1 object deck 

♦STORE card for DIV 

DIV object deck 

♦STORE card for DPACK/DUNPK 



DPACK/ DUNPK object deck 
*STORE card for EDIT 
EDIT object deck 
*STORE card for FILL 
FILL object deck 
♦STORE card for GET 
GET object deck 

♦ STORE card for ICOMP 
ICOMP object deck 

♦ STORE card for IOND 
IOND object deck 
♦STORE card for MOVE 
MOVE object deck 

♦ STORE card for MPY 
MPY object deck 

♦ STORE card for NCOMP 
NCOMP object deck 

♦ STORE card for NSIGN 
NSIGN object deck 

♦ STORE card for NZONE 
NZONE object deck 

♦STORE card for PACK/UNPAC 



PACK/ UNPAC object deck 
♦STORE card for PRINT /SKIP 



Number of 


Columns 


Cards 


76-80 


1 


00000 


1 


00010 


24 


00020-00250 


1 


00260 


9 


00270-00350 


1 


00360 


6 


00370-00420 


1 


00430 


4 


00440-00470 


1 


00480 


4 


00490-00520 


1 


00530 


4 


00540-00570 


1 


00580 


8 


00590-00660 


1 


00670 


5 


00680-00720 


1 


00730 


7 


00740-00800 


1 


00810 


3 


00820-00840 


1 


00850 


6 


00860-00910 


1 


00920 


5 


00930-00970 


1 


00980 


3 


00990-01010 


1 


01020 


3 


01030-01050 


1 


01060 


6 


01070-01120 


1 


01130 


3 


01140-01160 


1 


01170 


3 


01180-01200 


1 


01210 


4 


01220-01250 


1 


01260 


4 


01270-01300 


1 


01310 



2. 



41. PRINT/ SKIP object deck 

42. *STORE card for PUT 

43. PUT object deck 

44. *STORE card for P1403 /S1403 

45. P1403 /S1403 object deck 

46. *STORE card for P1442 

47. P1442 object deck 

48. * STORE card for READ /PUNCH 

49. READ /PUNCH object deck 

50. *STORE card for R2501 

51. R2501 object deck 

52. *STORE card for STACK 

53. STACK object deck 

54. *STORE card for TYPER/KEYBD 

55. TYPER /KEYBD object deck 

56. * STORE card for WHOLE 

57. WHOLE object deck 

58. *STORE card for ARGS 

59. ARGS object deck 

60. Sample Problem 1 FOR card 

61. Sample Problem 1 FORTRAN source deck 

62. Sample Problem 1 EXECUTE card 

63. Sample Problem 1 data 

64. Sample Problem 2 FOR card 

65. Sample Problem 2 FORTRAN source deck 

66. Sample Problem 2 EXECUTE card 
'67. Sample Problem 2 data 

68. Sample Problem 3 JOB and FOR cards 

69. Sample Problem 3 FORTRAN source deck 

70. Sample Problem 3 EXECUTE card 

71. Sample Problem 3 data 

TOTAL 



5 


01320-01360 


1 


01370 


5 


01380-01420 


1 


01430 


5 


01440-01480 


1 


01490 


5 


01500-01540 


1 


01550 


5 


01560-01600 


1 


01610 


5 


01620-01660 


1 


01670 


3 


01680-01700 


1 


01710 


5 


01720-01760 


1 


01770 


3 


01780-01800 


1 


01810 


5 


01820-01860 


1 


25940 


106 


25950-27000 


1 


27010 


198 


27020-28990 


1 


29000 


156 


29010-30560 


1 


30570 


93 


30580-31500 


2 


31510-31520 


55 


31530-32070 


1 


32080 


20 


32090-32280 


822 cards 





DECK KEY — OPTIONAL MACHINE -RE ADA BLE MATERIAL (SOURCE DECKS) 



(NOTES: The underlined name is the name under which the routine is stored. Columns 

73 - 75 contain CSP. The material is supplied in the form of card images on one reel 

of tape. ) 

Number of Columns 

Description Cards 76 - 80 

1. //JOB Card 

2. ADD/ SUB routine ALP source deck 

3 . Disk utility for storing ADD/ SUB 

4. A1A3/ A3A1 routine ALP source deck 
5.. Disk utility for storing A1A3/ A3A1 

6. A1DEC routine ALP source deck 

7. Disk utility for storing A1DEC 

8. CARRY routine ALP source deck 

9. Disk utility for storing CARRY 

10. DECA1 routine ALP source deck 

11. Disk utility for storing DECA1 

12. DIV routine ALP source deck 

13. Disk utility for storing DIV 

14. DPACK /DUNPK ALP source deck 

15. Disk utility for storing DPACK /DUNPK 

16. EDIT routine ALP source deck 

17. Disk utility for storing EDIT 

18. FILL routine ALP source deck 

19. Disk utility for storing FILL 

20. GET routine ALP source deck 

21. Disk utility for storing GET 

22. ICOMP routine ALP source deck 

23. Disk utility for storing ICOMP 

24. IOND routine ALP source deck 

25. Disk utility for storing IOND 

26. MOVE routine ALP source deck 

27. Disk utility for storing MOVE 

28. MPY routine ALP source deck 

29. Disk utility for storing MPY 

30. NCOMP routine ALP source deck 

31. Disk utility for storing NCOMP 

32. NSIGN routine ALP source deck 

33. Disk utility for storing NSIGN 

34. NZONE routine ALP source deck 

35. Disk utility for storing NZONE 

36. PRINT/SKIP routine ALP source deck 



1 


00010 


180 


00020-01810 


2 


00182-00183 


140 


01840-03230 


2 


03240-03250 


83 


03260-04080 


2 


04090-04100 


76 


04110-04860 


2 


04870-04880 


85 


04890-05730 


2 


05740-05750 


243 


05760-08180 


2 


08190-08200 


99 


08210-09190 


2 


09200-09210 


217 


09220-11380 


2 


11390-11400 


37 


11410-11770 


2 


11780-11790 


105 


11800-12840 


2 


12850-12860 


129 


12870-14150 


2 


14160-14170 


13 


14180-14300 


2 


14310-14320 


45 


14330-14770 


2 


14780-14790 


167 


14800-16460 


2 


16470-16480 


49 


16490-16970 


2 


16980-16990 


49 


17000-17480 


2 


17490-17500 


83 


17510-18330 


2 


18340-18350 


66 


18360-19010 



37. Disk utility for storing PRINT /SKIP 

38. PUT routine ALP source deck 

39. Disk utility for storing PUT 

40. PU03 /S1403 routine ALP source deck 

41 . Disk utility for storing P1403 /S1403 

42. PI 44 2 routine ALP source deck 

43. Disk utility for storing P1442 

44. READ /PUNCH routine ALP source deck 

45. Disk utility for storing READ /PUNCH 

46. R2501 routine ALP source deck 

47. Disk utility for storing R25 01 

48. STACK routine ALP source deck 

49. Disk utility for storing STACK 

50. TYPER /KEYBD routine ALP source deck 

51 . Disk utility for storing TYPER /KEYBD 

52. PACK/ UNPAC routine ALP source deck 

53. Disk utility for storing PACK /UNPAC 

54. WHOLE routine ALP source deck 

55. Disk utility for storing WHOLE 

56. ARGS routine ALP source deck 

57. Disk utility for storing ARGS 

58. Sample Problem 1 FOR card 

59. Sample Problem 1 FORTRAN source deck 

60. Sample Problem 1 EXECUTE card 

61. Sample Problem 1 data 

62. Sample Problem 2 FOR card 

63. Sample Problem 2 FORTRAN source card 

64. Sample Problem 2 EXECUTE card 

65. Sample Problem 2 data 

66. Sample Problem 3 JOB and FOR cards 

67. Sample Problem 3 FORTRAN source deck 

68. Sample Problem 3 EXECUTE card 

69. Sample Problem 3 data 

TOTAL 



2 


19020-19030 


109 


19040-20120 


2 


20130-20140 


74 


20150-20880 


2 


20890-20900 


53 


20910-21430 


2 


21440-21450 


83 


21460-22280 


2 


22290-22300 


61 


22310-22910 


2 


22920-22930 


16 


22940-23090 


2 


23100-23110 


81 


23120-23920 


2 


23930-23940 


66 


23950-24600 


2 


24610-24620 


38 


24630-25000 


2 


25010-25020 


89 


25030-25910 


2 


25920-25930 


1 


25940 


106 


25950-27000 


1 


27010 


198 


27020-28990 


1 


29000 


156 


29010-30560 


1 


30570 


93 


30580-31500 


2 


31510-31520 


55 


31530-32070 


1 


32080 


20 


32090-32280 


3228 cards 





Note: This source tape is available on one Distribution Tape Reel (DTR), 9-track 
@ 800 or 1600 bpi. See page 7 for tape key. 



PREPARATORY SYSTEMS PROCEDURES 

This section includes information on how to use this package. The package is available 
in two forms: 

© Basic machine-readable form. This consists of object decks that can be stored on 
the disk using the Monitor Disk Utility Program. 

© Optional program material. This consists of the source statements, placed on a 
reel of magnetic tape in card image format. This material is for those users 
with card systems (no disk) and for those users who want the source cards so 
that they may modify the CSP routines. 

Note that the Program Reference Manual (H20-0241) contains listings of the source 
statements. Users who need only a few of the routines in source format may prefer 
to prepare the cards themselves rather than choose the magnetic tape option. 

BASIC MACHINE -READABLE OBJECT DECKS 

This deck of 822 cards is ready to be run as one JOB. It will delete 24 subroutines of 
Version 2 (if they are on the disk), store the 28 new subroutines in the User Area, and 
then execute three sample problems. 

Operating instructions are as follows: 

1 . Mount and make ready the disk cartridge on which the routines are to be stored. 

2. Place a cold start card in front of the 822-card library deck. (Use the proper cold 
start card, as applicable — that for Version 1 or for Version 2 of the Monitor. ) 

3. Ready the card reader and any other I/O devices to be used. 

4. Set the console switches to reflect which I/O devices you want the sample problem 
to use (Figure 1). 

5. Press IMMEDIATE STOP, RESET, and LOAD on the console. This will start the 
loading and execution process. 

6. Each of the three sample problems ends on a numbered STOP statement (see 
Figure 2). These STOPs indicate successful completion; press START to 
continue. 

NOTE: Sample problem 2 will not execute if Version 1 of the Monitor is in use. 



OPTIONAL PROGRAM MATERIAL 

The optional program material package consists of 3228 source card images on one 
Distribution Tape Reel (DTR), 9-track & 800 or 1600 bpi. 

Tape Key 

1 . Tapemark 

2. CSP source decks and sample problems, blocked 20 records per block, 80 
characters per record. 

3. Tapemark 

To punch the source cards, use program 360P-UT-053. The Utility Modifier Statement 
card should read as follows: 

//UTC, TR, FF, A=(80,1600), B=(80,80), IU, Ol 

To list, use program 360P-UT-052. The Utility Modifier Statement card should read 
as follows: 

//UTP, TL, FF, A=(80, 1600), B=(132), IR, Ol 

For additional parameters for an individual user, see IBM manuals IBM System/360 
Basic Programming Support Specifications , Card and Tape Utility Programs (C24-5026) 
and IBM System/360 BPS Operating Guide (C24-5027-1). 

With The 1130 Disk Monitor System 

The deck of 3328 cards is ready to be run as one JOB. It will assemble the 28 subroutines 
of Version 3, store them on the disk in the User Area, and then execute three sample 
problems. If a previous version of the Commercial Subroutines is present on the disk 
cartridge, the old routines must be deleted before attempting to store the new ones. 

Operating instructions are as follows: 

1. Mount and make ready the disk cartridge on which the routines are to be stored. 

2. Place a cold start card in front of the 3228 -card source deck. (Use the proper 
cold start card, as applicable — that for Version 1 or for Version 2 of the Monitor. ) 

3. Ready the card reader and any other I/O devices to be used. 

4. Set the console switches to reflect which I/O devices you want the sample problems 
to use (Figure 1). 



5. Press IMMEDIATE STOP, RESET, and LOAD on the console. This will start the 
loading and execution process. 

6. Each of the three sample problems ends on a numbered STOP statement (see 
Figure 2). These STOPs indicate successful completion; press START to continue, 

Note: Sample problem 2 will not execute if Version 1 of the Monitor is in use. 

Without The 1130 Disk Monitor System 

With an 1130 card system (no disk) the subroutines may be assembled with the card 
Assembler: 

1. Separate the 3228 -card deck into 28 assembler source (subroutine) decks and 3 
FORTRAN source (test problem) decks. Label each deck. 

2. Remove all cards with // in columns 1 and 2. 

3. Remove all * STORE cards. 

4. The subroutines may now be assembled. Place a subroutine source deck in the 
card reader behind the Core Image Loader and the Assembler decks. 

5. Press IMMEDIATE STOP and RESET on the console. 

6. Ready all I/O devices. 

7. Press PROGRAM LOAD on the console. 

8. Press reader START to process the last two cards. 

9. Remove the source deck from stacker 2 and place it in the read hopper again. 

10. Press START in the reader. Pass 2 now begins. 

11. Press START on the reader to process the last two cards. The "list deck" so 
obtained may now be processed by the compressor program for later use. 

12. After each subroutine is compressed, it may be placed in the Card Subroutine 
library. 



The three sample problems may be compiled and executed in accordance with the 
standard FORTRAN procedures. 



Input 
Device 


Output 
Device 




Switches 







1 


2 


1442 


console printer 


down 


down 


down 


1442 


1132 


up 


down 


down 


1442 


1403 


up 


up 


down 


2501 


console printer 


down 


down 


up 


2501 


1132 


up 


down 


up 


2501 


1403 


up 


up 


up 



Figure 1. Console switch settings for sample problems 



Sample 
Problem 


STOP 
codes 


1 
2 
3 


1111 
0111 
3333 



Figure 2. Stop codes displayed in accumulator by sample problems 



REQUIRED PROGRAMMING SYSTEMS 

IBM 1130 FORTRAN - 1130-FO-001 

IBM 1130 Assembler - 1130-SP-001 

IBM 1130 Subroutine Library - 1130-LM-001 

IBM 1130 Utility Routines - 1130-UT-001 

or 
IBM 1130 Monitor System - 1130-OS-005 

or 
IBM 1130 Monitor System, Version 2 — 1130-OS-005 

MINIMUM MACHINE CONFIGURATION 

For execution: Any 8K 1130 System, with card reader 
For assembly: Any 4K 1130 System, with card reader 

MAINTENANCE PROCEDURES 

This program will be maintained through the use of serially numbered modification levels 
Any unmodified system is considered to be modification level 0. Each subsequent modi- 
fication raises the modification level by 1. The initial availability of this program is 
version 1 modification level 0. Should the nature or number of changes become large, 
a new version will be distributed. Each major revision raises the version number by 1\ 
modification levels to a new version begin at 1. 

Modification letters will be mailed to all previous recipients of the program. All modi- 
fication letters will be supplied with the program. The change or alter cards will be 
included in the deck to reflect the latest changes. 

An Authorized Programming Analysis Report (APAR) should be submitted through your 
local IBM system engineer to report any difficulties encountered in the use of this system. 
The APAR should be addressed to APAR Processing, IBM Application Programming 
Standards, 112 East Post Road, White Plains, New York. 
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^^ t = Application Program H20-0241-3 



1130 Commercial Subroutine Package 
(113Q-SE-25X), Version 3, Modification 1 

Program Reference Manual 



The IBM 1130 Commercial Subroutine Package is for IBM 
1130 users with a knowledge of FORTRAN. The package is 
not intended to make FORTRAN a complete commercial 
language, but to supply commercial capability to users of 
IBM 1130 FORTRAN. 

This manual is a combined user's, operator's, and system 
manual. 



Form H20-0241-3 

Front Cover revised 10/11/68 

ByTNLN20-1888 



Fourth Edition 

This edition, H20-0241-3, is a major revision obsoleting H20-0241-2. 

A form is provided at the back of this publication for reader's comments. 

If the form has been removed, comments may be addressed to IBM Corporation, 

Technical Publications Department, 112 East Post Road, White Plains, N.Y. 10601. 

© Copyright International Business Machines Corporation 1966, 1967, 1968 
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INTRODUCTION 

The 1130 Commercial Subroutine Package has been written to facilitate the use of 
FORTRAN in basic commercial programming. Included in the package are the following 
items: 

• The GET routine, which allows the programmer to decode input records after they 
have been read. This eliminates the common FORTRAN-associated problem that 
occurs when input cards enter the system in an unknown sequence. Input records 
that vary in this way may be read with the Al format and converted to real numbers 
(using GET) after the program has determined which type record was just read. 

• An editing routine, EDIT, for the preparation of output in special formats. With 
EDIT it is possible to insert commas, supply leading blanks, float dollar signs, 
display a CR symbol after negative numbers, etc. EDIT is especially useful in the 
preparation of invoices, checks, and other commercial documents. 

• Code conversion routines for data manipulation and more efficient data packing: 

GET - Al format to Real 

PUT - Real to Al format 

PAQlKj - Al to A2 format 

UNPAC -. A2 to Al format 

A1A3 - Al to A3 format 

A3A1 - A3 to Al format 

DPACK - Dl to D4 format 

DUNPK - D4 to Dl format 

A1DEC - Al to decimal format 

DECA1 - Decimal to Al format 

• A variable-length decimal arithmetic package. In this system, all arithmetic is done 
with integer or decimal numbers, with field lengths chosen by the user. This subset 
of the Commercial Subroutine Package includes routines for variable-length decimal 
add (ADD), subtract (SUB), multiply (MP Y), divide (DIV), compare (ICOMP), and 
sign test (NSIGN). 

Use of this system eliminates two of the arithmetic problems associated with 
FORTRAN: the accuracy problem (the inexact representation of fractions) and the 
magnitude problem (extended precision values limited to nine digits, etc.). 

• Subroutines for improved speed and control of I/O devices. By taking advantage of 
the 1130 ! s cycle-stealing capability, the overlapped I/O routines can substantially 
speed the throughput rates of many jobs. Subroutines are supplied for the 

IBM 1442 Card Read Punch 
IBM 1442-5 Card Punch 
IBM 2501 Card Reader 
IBM 1132 Printer 
IBM 1403 Printer 
Console Keyboard 
Console Typewriter 



In addition to input/output, subroutines are supplied for control of the 1132 and 1403 
carriage and the 1442 stacker select mechanism. 

Several utility routines for common tasks: 

NCOMP for comparing two variable-length alphameric (Al) fields 

MOVE for moving data from one area to another 

FILL to fill an area with a specified value 

WHOLE to truncate the fractional portion of a real number 

NZONE for testing and modifying zone punches 



USE OF THE COMMERCIAL SUBROUTINE PACKAGE 

CSP is modular in design — the user may use whichever routines he needs and ignore the 
others. 

The routines may be assembled on any 4K card 1130 system, but an 8K system will prob- 
ably be required for any extensive usage. The desired subroutines may be inserted in the 
FORTRAN execute deck (card systems) or stored in the Subroutine Library on the disk 
cartridge. In addition, some of the CSP routines use certain parts of the IBM 1130 Sub- 
routine Library. (See n Core Allocation" in the Appendix.) 

All of the routines are written in the 1130 Assembler Language. 

The control statement 

*ONE WORD INTEGERS 
must be used in programs that call any of the Commercial subroutines. 
The control statement 

*EXTENDED PRECISION 

must be used in any program that calls the GET or PUT subprograms. The other CSP 
routines are independent of the real number precision. 

In general, CSP will operate under either Version 1 or Version 2 of the 1130 Disk Monitor 
System. The exceptions are P1403, S1403, P1442, and R2501, which use subroutines 
supplied only with Version 2 (see the detailed descriptions for more particulars). 

The use of the overlapped I/O portion of CSP is an M either/or M proposition. For nondisk 
I/O, the programmer must choose either the CSP overlapped routines or the standard 
FORTRAN routines. The two systems cannot be intermixed within the same program. 
Note the emphasis on nondisk. This exclusion does not apply to disk I/O, which may 
be used regardless which of the two systems is selected. 

Use of the overlapped I/O routines also excludes the employment of the TRACE feature 
of FORTRAN, since it used portions of the FORTRAN package for output. 



MACHINE REQUIREMENTS 

For execution, an 8K 1130 system, with any card reader, is necessary. In addition, the 
following I/O devices are supported: 

1442 Card Read Punch, Model 6 or 7 

1442 Card Punch, Model 5 

2501 Card Reader, Model Al or A2 

1403 Printer, Model 6 or 7 

1132 Printer 

Console Keyboard 

Console Typewriter 

Other I/O devices may be utilized through standard FORTRAN. 

For assembly, any 1130 card system is sufficient. The subroutines may be card- or 
disk-resident. 



SPECIAL CONSIDERATIONS - ARITHMETIC 

Real arithmetic . When using CSP, remember that the standard FORTRAN limitations 
apply to all real numbers. 

Extended precision numbers should not exceed ±1,000,000,000. (or 9 digits). 

Fractions must be avoided if exact results are desired. All critical arithmetic should be 
done with whole numbers. For example, the extension 

40. 75 hours x $2. 225 per hour 
should be carried out as 

4075. hundredths of hours x 2225. mills per hour 

If this is not done, precision errors may appear in the results. 

Decimal arithmetic . If the nine-digit or fractional limitations of FORTRAN prove burden- 
some, the Decimal Arithmetic package may be used. In this system, all arithmetic is 
done with whole numbers (no fractions), and the number of digits in each variable is 
chosen by the user. 

A number in decimal format may be as long as desired; there is no practical limit to 
field length. 



SPECIAL CONSIDERATIONS - INPUT/OUTPUT 

FORTRAN FORMAT I/O 

In general, CSP works with arrays in Al format — one alphameric character per word. 
For those routines that operate on other formats, conversion routines are supplied to 
ease the translation between Al and the other format. 

In this area, however, one complication may occur: the use of zone punches. In many 
commercial applications, it is customary to X-punch the units position of a credit or neg- 
ative field. Because the 11-0 Hollerith combination is not recognized by the conversion 
routines used with FORTRAN READs, it is necessary, when keypunching, to omit the 0- 
punch when an 11-punch is present in the same column. This is not a problem with 1130- 
produced cards that later serve as input to subsequent runs. No control X-punches, in 
any positions, will be recognized when the underpunched digit is a zero. "Not recognized" 
means that the character position is replaced with a blank. This is the case for both input 
and output when standard FORTRAN READs and WRITE s are used. 

A 12-punch is not recognized by the conversion routines with FORTRAN when the under- 
punched digit is a zero. Therefore, a plus zero (12-0 Hollerith) will be expressed as 
only a -punch. For this reason, plus fields should be left unzoned rather than 12-punched 
in the units position. 

When the input routines supplied with this package are used, this problem does not exist. 
All zone punches are recognized and are treated properly. 

CSP OVERLAPPED I/O 

The CSP overlapped I/O routines have been provided to take advantage of the cycle- 
stealing capability of the 1130. Because many allow processing to be resumed before the 
I/O is finished, their use will increase the throughput rates of many programs. 

The table below summarizes the overlap capabilities of the routines: 



This device 


is overlapped with this function 


Card reader (1442 or 2501) 
Card punch 
Console keyboard 
Console printer 
Printer (1132 or 1403) 


Conversion from card code to Al format 
nothing (not overlapped) 
nothing (not overlapped) 
anything but the console keyboard 
anything 



The CSP I/O routines also permit the reading and punching of the 11-0 and 12-0 punches, 
both of which must be avoided with standard FORTRAN I/O. 
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The use of the overlapped I/O portion of CSP is an "either/or " proposition. For nondisk 
I/O, the programmer must choose either the CSP overlapped routines or the standard 
FORTRAN routines. The two systems cannot be intermixed within the same program. 
Note the emphasis on nondisk. This exclusion does not apply to disk I/O, which may be 
used regardless which of the two systems is selected. 

Use of the overlapped I/O routines also excludes the employment of the TRACE feature 
of FORTRAN, since it uses portions of the FORTRAN package for output. 

The following routines are included in the CSP I/O group: 



-READ' 


PRINT 


TYPER 


PUNCH 


SKIP 


KEYBD 


2*2501- 


P1403 


STACK 


P1442 


S1403 





If any of these routines are used, standard FORTRAN READ and WRITE commands may 
not appear in the same program. 

When using Version 1 of the 1130 Disk Monitor System, the programmer must place the 
statement 

CALL IOND 

before any STOP or PAUSE statement. This will ensure that all pending I/O interrupts 
have been serviced before the CPU stops or pauses. IOND should not be called if Version 
2 of the Monitor is in use. 

P1403, S1403, P1442, and R2501 use parts of the subroutine library supplied with Version 
2 of the 1130 Disk Monitor System. If they are to be used with a Version 1 Monitor, the 
Version 2 subroutines must be loaded onto the Version 1 disk. See the detailed descrip- 
tions of P1403, S1403, P1442, and R2501 for more particulars. 

DATA FORMATS USED 

Although most of the CSP routines are oriented toward use of the Al format, several new 
formats have been introduced. In addition, several of the standard formats must be con- 
sidered in a different light. 

Al FORMAT 

Al format consists of one character per 16-bit word, left-justified: 



character 


blank 



bits 78 15 
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The right-hand eight bits should always contain the blank character, which is Uxv 000 in 
binary. This blank will always be inserted by the CSP routines and the standard FORTRAN 
Al format. 

The sign of an A 1 field is assumed to be carried as an 11- or 12-punch over the rightmost 
character. An 11-punch is taken to signify a negative field; a 12-punch (or no-zone punch) 
signifies a positive field. 

A2 FORMAT 

A2 format consists of two characters per word: 



character 


character 



bits 7 8 15 



A3 FORMAT 

Although A3 format exists in standard FORTRAN terminology, its use in this manual has 
a different connotation. Here, A3 format means that one word contains three characters. 

This can be done only by using a unique coding scheme. The user supplies a table of 40 
characters. Then, the A1A3 and A3A1 subroutines may be used to translate from Al to 
A3 format and vice versa. 

The A3 format cannot be pictured graphically, since the three characters are combined 
as a single integer or binary number. 

The A3 format permits highly efficient packing of alphabetic data and may be used to save 
considerable space on the disk. 

Note, however, that only 40 characters may be used. This may not be enough for some 
applications. For example, if the characters chosen were A through Z, through 9, the 
blank, comma, period, and dash, 40 would probably be ample for a name and address 
file. It would not be sufficient for a product description file that also required slashes, 
dollar signs, etc. 

Dl FORMAT 

Dl format consists of one digit per word, right-justified. Because the decimal arithmetic 
routines operate on data in this format, Dl format is also called decimal format. 

Dl format is as follows: 



00000000 



0000 digit 



bits 7 8 15 
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A decimal field is stored in an array in Dl format. The sign of the field will be carried 
with the rightmost digit. For example, the six-digit field 001968 could be placed in the 
12th through 17th position in the NUMBR array: 

NUMBR(12)=0 
NUMBR (13) =0 
NUMBR(14) = 1 
NUMBR(15) = 9 
NUMBR (16) = 6 
NUMBR (17) = 8 

The same field, if it were negative, would be written as 001968, and the sign would be 
reflected in the rightmost digit: 

NUMBR (12) = 
NUMBR (13) = 
NUMBR (14) = 1 
NUMBR(15) = 9 
NUMBR(16) = 6 
NUMBR (17)= -9 



Note that NUMBR (17) is -9 rather than -8; this must be done because the 1130 cannot 
represent a negative zero. The following scheme is used with negative numbers; 



If the sign of the field is 

negative and the rightmost The rightmost Dl digit 

digit is a will be carried as a 






-1 


1 


-2 


2 


-3 


3 


-4 


4 


-5 


5 


-6 


6 


-7 


7 


-8 


8 


-9 


9 


-10 



Usually, this need not concern the programmer, since the A1DEC and DECA1 routines 
will automatically implement the special coding of negative fields. Setting up negative 
constants, though, must be handled properly by the programmer. 
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D4 FORMAT 

D4 format consists in general of four decimal digits per word, with each digit occupying 
four bits of the word. However, since the sign digit (the rightmost one) carries the sign, 

it is handled separately, and is placed by itself in the last word of the D4 field. This is 
best illustrated by showing several examples: 



The five-digit 

number 

+ 12345 



first word 


second word 


1 2 3 4 


+ 5 


0001 0010 0011 0100 


0000 0000 0000 0101 



The six-digit 
number 
+ 123456 



first word 


second word 


third word 


12 3 4 


5 F F F 


+ 6 


0001 0010 0011 0100 


0101 1111 1111 1111 


0000 0000 0000 0110 



The seven-digit 

number 

+ 1234567 



first word 


second word 


third word 


12 3 4 


5 6 F F 


+ 7 


0001 0010 0011 0100 


0101 0110 1111 1111 


0000 0000 0000 0111 



The filler consists of four 1 bits, the hexadecimal F. A more detailed description of D4 
format may be found with the description of the DPACK routine. 
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FORMAT REQUIREMENTS 



The requirements for each subroutine are as follows: 



Subroutine 


Format of 
Data before 
Processing 


Format of 
Data after 
Processing 


ADD 


Dl format 


Dl format 


A1A3 


Al format 


A3 format 


A1DEC 


Al format 


Dl format 


A3A1 


A3 format 


Al format 


CARRY 


Dl format 


Dl format 


DECA1 


Dl format 


Al format 


DIV 


Dl format 


Dl format 


DPACK 


Dl format 


D4 format 


DUNPK 


D4 format 


Dl format 


EDIT 


Al format 


Al format 


FILL 


Any integer 
(Al, A2, Dl, 
etc.) 


Same as 

FILL 

character 


GET 


Al format 


Real variable 

(extended 

precision) 


ICOMP 


Dl format 


Greater than, 
equal to, or 
less than zero 


IOND 


None 


None 


KEYBD 


Al format 


Al format 


MOVE 


Any integer 
(Al, A2, Dl, 
etc.) 


Same as 

before 

MOVE 


MPY 


Dl format 


Dl format 


NCOMP 


Al format 


Greater than, 
equal to, or 
less than zero 



Subroutine 


Format of 
Data before 
Processing 


Format of 
Data after 
Processing 


NSIGN 


Dl format 


Integer 
variable 


NZONE 


Al format 


Integer 
variable 


^PAGK 


Al format 


A2 format 


PRINT 


Al format 


Al format 


PUNCH 


Al format 


Al format 


PUT 


Real variable 

(extended 

precision) 


Al format 


T2L1-J.AQ 




A 1 format 




jflrX JLUX'IIXctl/ 


P1442 


Al format 


Al format 


-READ 


Al format 


Al format 


R2501— - 


-A 1 format 


A 1 format 


SKIP 


Decimal 
constant 


None 


STACK 


None 


None 


SUB 


Dl format 


Dl format 


S1403 


Decimal 
constant 


None 


TYPER 


Al format 


Al format 


UNPAC 


A2 format 


Al format 


WHOLE 


Real variable 

(any 

precision) 


Real variable 

(any 

precision) 
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DETAILED DESCRIPTIONS 

This section gives the general format and a description of each routine. Each description 
contains format, function, parameter description, detailed description, example, errors, 
and remarks. The function describes the capabilities of the routine. The parameter 
description explains in detail how the parameters, variables, and constants should be set 
up. The detailed description tells exactly what the subroutine does and how it should be 
used. Examples are given as an aid to the programmer. Certain specification and input 
errors may occur when using the package, and these are explained. The remarks section 
describes some peculiarities of the routine. Further information may be obtained from 
the flowcharts and listings. 
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ADD 

Format: CALL ADD(JCARD, J, JLAST, KCARD, K, KLAST, NER) 

Function: Sums two arbitrary-length decimal data fields, placing the result in the 
second data field. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 

statement. This is the array which is added, the addend. The data must 
be stored in JCARD in decimal format, one digit per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first digit to be added (the left-hand end of a field). 

JLAST - An integer constant, an integer expression, or an integer variable, 
greater than or equal to J. This is the position of the last digit to be 
added (the right-hand end of a field) . 

KCARD - The name of a one -dimensional integer array defined in a DIMENSION 

statement. This is the augend, the array which is added to. It will con- 
tain the result in decimal format, one digit per word. 

K - An integer constant, an integer expression, or an integer variable. This 
is the position of the first digit of KCARD (the left-hand end of a field). 

KLAST - An integer constant, an integer expression, or an integer variable, 

greater than or equal to K. This is the position of the last character of 
KCARD (the right-hand end of a field). 

NER - An integer variable. Upon completion of the subroutine, this variable 
indicates whether arithmetic overflow occurred. 

Detailed description : The corresponding digits, by place value, of JCARD and KCARD, 
are summed and placed back in KCARD. This operation is from left to right, with both 
fields being right-adjusted. Next, all carries are set in order. If overflow occurred, 
it is indicated by NER being equal to KLAST. NER must be initialized and reset by the 
user. More detailed information may be found in the ADD flowchart and listing. 
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Example: DIMENSION IGRND(12),ITEM(6) 
N=0 
CALL ADD(ITEM, 1, 6, IGRND, 1, 12, N) 



Before: 



IGRND 000713665203 

■' 4 x i. 



Position 1 5 10 



ITEM 102342 



■ ' - 



Position 1 5 



N=0 



After: 



IGRND 000713767545 



ITEM is unchanged. 



Position 1 



N=0 



10 



The numeric data field ITEM, in decimal format, is ADDed to 
the numeric data field IGRND, also in decimal format. Note 
that the fields are both right-justified. The error indicator, 
N, is the same, since there is no overflow out of the high-order 
digit (left-hand end) of the IGRND field. 



Errors : If the KCARD field is not large enough to contain the sum, that is, if there is a 
carry out of the high-order digit, the error indicator, NER, will be set equal to KLAST, 
and the KCARD field will be filled with 9s. 

If the JCARD field is longer than the KCARD field, nothing will be done and the error in- 
dicator will be equal to KLAST. 

Remarks : Conversion from EBCDIC to decimal is necessary before using this subroutine. 
This may be accomplished with the A1DEC subroutine. 

The length of the JCARD and KCARD fields is arbitrary, up to the maximum space 
available. 

Note that the error indicator is not reset by this subroutine. It is the responsibility of the 
user to initialize, test, and reset the error indicator. 
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A1A3 

Format: CALL A1A3(JCARD, J, JLAST, KCARD, K, ICHAR) 

Function : To convert from Al format (one character per word) to A3 format (three 
characters per word) . 

Parameter description: 

JCARD - The name of a one -dimensional integer array defined in a DIMENSION 
statement. This array contains the field to be converted. Originally, 
this field must be in Al format, one character per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of JCARD to be converted (the left- 
hand end of a field) . 

JLAST - An integer constant, an integer expression, or an integer variable. This 
is the position of the last character of JCARD to be converted (the right- 
hand end of a field) . 

KCARD - The name of a one -dimensional integer array defined in a DIMENSION 
statement. This is the array into which the data is converted, in A3 
format, three characters per word. 

K - An integer constant, an integer expression, or an integer variable. This 
is the position of the first element of KCARD to receive the converted 
characters (the left-hand end of a field). 

ICHAR - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array contains a table used in the conversion. 

Detailed description : Three characters in Al format are taken, one at a time, from the 
JCARD array. The relative position of each character is found in the table ICHAR. 
Then these three relative positions are used to form an A3 integer as follows: 



ADD 
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A3 INTEGER=(Nl-20)* 1600+(N2*40)+N3 

where Nl is the relative position of the first character in the ICHAR array, etc. The 
A3 integer is then placed in the KCARD array, and the next group of three Al characters 
is packed, and so on. Note that the relative position runs from to 39, not 1 to 40. 
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Form H20-0241-3 
Revised 10/11/68 
ByTNLN20-1888 



Example: 



Content 



Card column 



Relative position 



Setup ICHAR as follows: 

DIMENSION ICHAR(40) 
READ(2,1) ICHAR 
FORMAT (40A1) 

or 

DIMENSION ICHAR(40) 
CALL READ(ICHAR, 1,40,N) 

The card to be read is: 
ETAOINbSHRDLUCMFWYP0123456789VBGKQJXZ , . & 

t t t t t t t t t 

1 5 10 15 20 25 30 35 40 



14 



19 24 29 



34 



39 



It is the user's responsibility to create the ICHAR array. It must always contain 
40 characters, one of them a blank. 

A1A3 may be used as follows: 

DIMENSION JCARD(21) , KCARD( 10) ,ICHAR(40) 
CALL A1A3(JCARD, 1, 21,KCARD, 1, ICHAR) 



Before: 



JCARD CUSTOMER NAME IS HERE 

t t t t t 



Position 

KCARD 

Position 

ICHAR is as above 



10 



15 20 



0123456789 

f ♦■ A 

1 5 10 



After: 

KCARD 
Position 



JCARD is the same. 
ICHAR is the same. 
-10713 -30266 -31634 -23906 -31756 -20552 -31640 7 8 9 



7 8 9 

tit 

8 9 10 



Represents CUS TOM ERb NAM Ebl SbH ERE 

The large negative numbers at each of the first seven positions reflect A3 integers 

(three Al characters). 
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Errors: ^ a character does not appear in ICHAR, and does appear in J CARD, it will be 
coded as a blank. 

Remarks : It is the user's responsibility to create the ICHAR array. It must always 
contain 40 characters. The arrangement shown in the example is, in general, the best, 
since the characters appear in the order of their most frequent occurrence, and this 
arrangement includes those characters (A-Z, 0-9, blank, comma, period, and ampersand) 
commonly found in alphabetic files (names and addresses, etc.). The user may, however, 
place any 40 characters in the ICHAR array, in any order. 

If the field to be compressed consists primarily of numbers, for example, they should be 
placed first in the ICHAR array. 

Note that the A3 format discussed here is a special one and is not the same as the 
FORTRAN A3 format. 
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A1DEC 

-«- Format : CALL A1DEC(JCARD,J,JLAST,NER) 

Function : Converts a field from Al format, one digit per word, to decimal format, 
right- justified, one digit per word. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This is the name of the field that will be converted. Orig- 
inally, this field must be in Al format* one character per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of JCARD to be converted (the left- 
hand end of a field) . 

JLAST - An integer constant, an integer expression, or an integer variable, 

greater than or equal to J. This is the position of the last character of 
JCARD to be converted (the right-hand end of a field). 

NER - An integer variable. This variable will be equal to the position of the 

last invalid (nonnumeric or nonblank) character encountered, except for 
the JLAST position, which may contain a sign. 

Detailed description : The subroutine operates from left to right. Each character is 
checked for validity (digit or blank). Blanks are changed to zeros. If a character is 
invalid, the error indicator, NER, is set equal to the position of the character. If the 
character is valid, it is converted to decimal format and right -justified using the for- 
mula 



Decimal digit = (character+4032)/256 

When all characters have been converted, the decimal field is signed, 
information may be found in the A1DEC flowchart and listing. 



More detailed 
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Example: DIMENSION IFLD(20) 

N=0 
CALL A1DEC(IFLD,7,17,N) 



Before: 



7,17 



IFLD AbBbCbDbEbFbbbbbbbbb0b7blb3b,6b6bJbEbNbDb 



Position 



10 



15 



N=0 



20 



After: 



7,17 

A 



IFLD AbBbCbDbEbFb00000713661EbNbDb 



Position 



10 15 



20 



N=0 



Before execution, the field is shown in Al format, the character followed by a blank. 
Therefore , the field to be converted is 

bbbb071366J 

After execution, the field has been converted, as is evident. There were no invalid 
characters in the field, since N is the same. 

Errors : If an invalid character (nonnumeric or nonblank) is encountered, the error 
indicator is set equal to the position of that character, and processing of the field 
continues. 

Remarks: When the error indicator has been set, the character indicated is the last 
invalid character. There may be' other invalid characters in the field, occurring to 
the left of the character noted. 
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Zone punches are used, at times, to indicate conditions (switches). These zones can be 
removed with the NZONE subroutine. Following is an error routine to correct errors 
of this type: 

Main Line 



1 GALL A1DEC(IFLD,J,JLAST,N) 
IF(N) 2,2,3 

2 Continue Main Line 



Error Routine 





CALL NZONE(IFLD,N,4,Nl) 




N1=0 




CALL A1DEC(IFLD,N,N,N1) 




IF(N1) 5,5,4 


4 


STOP 999 


5 


CALL DECA1(IFLD,J,JLAST 



N=0 

GO TO 1 

When an error of this type occurs, N will be greater than zero. Control would go to 
statement 3. Using the NZONE routine, the zone is removed (if not a special character), 
The invalid character is now converted with the A1DEC routine. If the character is still 
invalid, control goes to statement 4 and the program will STOP. If the character is now 
valid, it has been converted and control goes to statement 5. However, there may have 
been other invalid characters. Therefore, at statement 5 the field is converted back to 
Al format and control returns to statement 1, where the field is again converted from 
Al format to decimal format. This process continues until a truly invalid character 
(special character) is encountered, or until the field is converted with no errors. 

Note that the error indicator is not reset by this subroutine. It is the responsibility 
of the user to initialize and reset the error indicator. 
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A3A1 

Format : CALL A3A1(JCARD, J, JLAST, KCARD, K, ICHAR) 

Function : To convert from A3 format (three characters per word) as created by the 
A1A3 subroutine to Al format (one character per word). 

Parameter description 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array contains the field to be converted. Originally, 
this field must be in A3 format, three characters per word. 

J - An integer constant, an integer expression, or an integer variable. 

This is the position of the first element of JCARD to be converted (the 
left-hand end of a field) . 

JLAST - An integer constant, an integer expression, or an integer variable. 

This is the position of the last element of JCARD to be converted (the 
right-hand end of a field). 

KCARD - The name of a one- dimensional integer array defined in a DIMENSION 
statement. This is the array into which the data is converted, in Al 
format, one character per word. 

K - An integer constant, an integer expression, or an integer variable. 

This is the position of the first element of KCARD to receive the con- 
verted characters (the left-hand end of a field). 

ICHAR - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array contains a table used in the conversion. 

Detailed description : A3 integers are taken, one at a time, from the JCARD array. Each 
is decoded into the three numbers of which it is composed, as follows: 



Nl= 



( (A3 INTEGER/1600) + 20 if the A3 integer is positive ^ 

t ((A3 INTEGER + 32000)/l600) if the A3 integer is negative J 

N2=(A3 INTEGER-(Nl-20)*1600)/40 

N3=A3INTEGER-(N1-20)*1600-(N2*40) 

The resulting integers, Nl, N2, N3, are then used to locate their corresponding Al 
characters in the ICHAR array. Each Al character is then placed in the KCARD array. 

Note that each element of JCARD requires three elements in KCARD. 
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Example: 



Content 

Card 
column 

Relative 
position 



Set up ICHAR as follows: 

DIMENSION ICHAR(40) 

READ(2, 1) ICHAR 
1 FORMAT (40A1) 

or 

DIMENSION ICHAR(40) 
CALL READ(ICHAR,1,40,N) 

The card to be read is: 

ETAOINbSHRDLUCMFWYP0123456789VBGKQJXZ, . & 

I t I t I ! t f 



10 



15 



20 25 30 



35 



40 



4 



14 19 24 29 34 39 



It is the user ! s responsibility to create the ICHAR array. It must always contain 40 
characters. 

A3A1 may be used as follows: 

DIMENSION JCARD(21), KCARD(30), ICHAR(40) 

CALL A3A1(JCARD,1,8, KCARD, 1, ICHAR) 



Before: 



JCARD -30076 -20556 -20547 -26800 -15765 -23397 -17038 -30237 



Position 



KCARD 012345678901234567890123456789 

t I t t t f t 

Position 1 5 10 15 20 25 30 



ICHAR is as above. 



After: 



JCARD is the same. 
ICHAR is the same. 
KCARD THIS IS CODED INFORMATI0456789 

t * t t t t t 

Position 1 5 10 15 20 25 30 



22 



Errors; If JLAST is less than J, one element will be decoded into three characters. 

Remarks : It is the user 1 s responsibility to create the ICHAR array. It must always con- 
tain 40 characters. The arrangement shown in the example is, in general, the best, 
since it is in the order of the most frequent occurrence of the letters of the alphabet. 

Note that the A3 format discussed here is a special one, and is not the same as the 
FORTRAN A3 format. 
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CARRY 

Format : CALL CARRY(JCARD,J,JLAST,KARRY) 

■ Function : Resolve all carries within the specified field and indicate any high-order 

carry out of the field. This routine will not normally be called by the user . 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This is the field that will be interrogated for carries. The 
data must be in decimal format. 

J - An integer constant, an integer expression, or an integer variable. 
This is the position of the first digit of JCARD (the left-hand end of a 
field). 

JLAST - An integer constant, an integer expression, or an integer variable, 
greater than or equal to J. This is the position of the last character 
of JCARD (the right-hand end of a field). 

KARRY - An integer variable. This variable will contain any carry out of the 
high-order position of the JCARD field. If there is no carry, KARRY 
will be set to zero. 

Detailed description : The routine operates from right to left, examining the low-order 
digit first. The digit being examined is divided by ten. Since only integers are used, 
the quotient of this division is the carry in that digit. Ten times the carry is subtracted 
from the digit. If the digit is now negative, ten is added to the digit and one is sub- 
tracted from the carry. At this point, or if the resultant digit was positive, the next 
digit to the left is examined. First, the carry from the previous digit is added to this 
digit. Then the process for the first digit, starting with division by ten, is carried out. 
When all digits have been examined, from JCARD(JLAST) to JCARD(J) inclusive, the 
final carry is set and the routine terminates. More detailed information may be found 
in the CARRY flowchart and listing. 
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Example: DIMENSION NUMB(IO) 

CALL CARRY(NUMB,UO,N) 



Before: 



NUMB 72 6 27 5 1 8 1 1 



ttlltil 



Position 12 3 4 56789 10 



N=22 



After: 



NUMB 0723350211 



Position 



10 



N=0 



After an arithmetic operation the condition of the NUMB field is as shown at "Before". 
The third, fifth and eighth positions appear as shown, because multiple arithmetic 
operations have generated them. The object of the CARRY routine is to resolve this 
type of problem. 

Notice that a 1 has been borrowed from the seventh position to resolve the -8 condition. 
Similarly, a 3 has been borrowed from the fourth position, and the 7 from 72 has gone 
into the second position. 

Errors: None 



Remarks : This routine is used by the other routines in this package as a service routine, 
In general, the user need not call this routine, since all carries are resolved by the 
arithmetic routines themselves (ADD, SUB, MPY, DIV). 
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DECA1 

Format : CALL DECA1(JCARD,J,JLAST,NER) 

Function: Converts a field from decimal format, right- justified, one digit per word, to 
Al format, one character per word. 

Parameter description : 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This is the name of the field that will be converted. Origi- 
nally, this field must be in decimal format, one digit per word. 

J - An integer constant, an integer expression, or an integer variable. 
This is the position of the first digit of JCARD to be converted (the 
left-hand end of a field) . 

JLAST - An integer constant, an integer expression, or an integer variable, 
greater than or equal to J. This is the position of the last character 
of JCARD to be converted (the right-hand end of a field). 

NER - An integer variable. This variable will be equal to the position of the 

last digit of JCARD which was negative or greater than 9, except for the 
JLAST position, which can be negative (sign). 

Detailed description : The subroutine operates from left to right. First the sign is de- 
termined. Then each digit, starting with JCARD( J) , is converted to Al format using the 
formula 

Character = 256 * (decimal digit) - 4032 

When all digits have been converted, the field is signed. More detailed information 
may be found in the DECA1 flowchart and listing. 
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Example: DIMENSION IFLD(20) 

N=0 
CALL DECA1(IFLD,7,17,N) 



Before: 



7,17 
—A — 



IFLD AbBbCbDbEbFb00000713661EbNbDb 



Position 



10 15 



20 



N=0 



After: 
IFLD 



7,17 



AbBbCbDbEbFb'0b0b0b0b0b7blb3b6b6bJbEbNbDb 



Position 



10 



15 



20 



N=0 



Before execution the field is shown in decimal format. The field to be converted is 

00000713661 

After execution, the field has been converted to Al format, as is evident, the character 
followed by a blank. There were no invalid digits in the field, since N is the same. 

Errors : If an invalid digit (not to 9, inclusive) is encountered, the error indicator is 
set equal to the position of that character, and processing of the field continues. 

Remarks : When the error indicator indicates an error, the digit indicated is the last 
invalid digit. There may be other invalid digits in the field, occurring to the left of the 
digit noted. 

These errors should not occur, since the arithmetic routines (ADD, SUB, MPY, and 
DIV) will resolve carries. However, if this does happen, the user f s program should 
indicate (possibly by STOPing) that this has occurred. 

Note that the error indicator is not reset by this subroutine. It is the responsibility of 
the user to initialize and reset the error indicator. 
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DIV 

Format : CALL DIV(JCARD,J,JLAST,KCARD,K,KLAST,NER) 

Function : Divides one arbitrary -length decimal data field by another, placing the 
quotient and remainder in the dividend. 

■ Parameter description : 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array is the divisor. The data must be stored in 
JCARD in decimal format, one digit per word. 

J - An integer constant, an integer expression, or an integer variable. 
This is the position of the first digit of the divisor (the left-hand end of 
afield). 

JLAST - An integer constant, an integer expression, or an integer variable, 

greater than or equal to J. This is the position of the last digit of the 
divisor (the right-hand end of a field) . 

KCARD- The name of a one -dimensional integer array defined in a DIMENSION 
statement. This array, the dividend, will contain the quotient and the 
remainder, extended to the left, in decimal format, one digit per word. 

K - An integer constant, an integer expression, or an integer variable. 
This is the position of the first digit of the dividend (the left-hand end 
of a field). 

KLAST - An integer constant, an integer expression, or an integer variable, 
greater than or equal to K. This is the position of the last digit of 
the dividend (the right-hand end of a field). This is also the position 
of the last digit of the remainder. 

NER - An integer variable. Upon completion of the subroutine, this variable 
indicates whether division by zero was attempted, or whether the 
KCARD field is not long enough. 

Detailed description : First the signs are cleared from both fields and saved. Then the 
KCARD field is extended to the left the length of the JCARD field (JLAST-J+1), and 
filled with zeros. If the KCARD field will be extended below KCARD(l), NER will be set 
equal to KLAST and the routine will be terminated. Next, the JCARD field is scanned to 
find the high-order significant digit. If no digit is found, the error indicator NER is set 
to KLAST, and the result is the same as the input. When a digit is found, the division 
begins. It is done by the method of trial divisors: 

1. The high-order digit of the divisor is used as the trial divisor. 

2. The trial divisor is divided into the next high-order digit of the dividend to generate 
a digit of the quotient. 

3. The digit of the quotient is multiplied by the trial divisor. 

4 . This product is subtracted from the corresponding number of digits in the high- 
order portion of the dividend. 
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5. As long as the result is positive, the quotient digit is the next digit in the quotient. 
A return is made to step 2. 

6. When the result is negative, the product from step 3 is added back to the dividend, 
1 is subtracted from the quotient digit, and the new quotient digit is placed in the 
quotient as the next digit. Finally, the signs are generated for the quotient and 
remainder and the sign is replaced on the divisor. 

The quotient will be located in the KCARD field. The subscript of the first digit of the 
quotient will be K-(JLAST-J+1) , and the subscript of the last digit of the quotient will be 
KLAST-(JLAST-J+1) . 

The remainder will also be located in the KCARD field. The subscript of the first digit 
of the remainder will be KLAST-JLAST+J, and the subscript of the last digit of the re- 
mainder will be KLAST. 



KCARD 



QUOTIENT 



K B 



REMAINDER 



t 1 1 t 



D 



A is the position whose subscript is K-(JLAST-J+1). 
K is the first position of the dividend, defined earlier. 
B is the position whose subscript is KLAST-(JLAST-J+1). 
C is the position whose subscript is KLAST-(JLAST-J). 
D is the position whose subscript is KLAST. 

More detailed information may be found in the DIV flowchart and listing. 



Example: 


DIMENSION IDVSR(5),IDVND(15) 






N=0 








CALL DIV(IDVSR,1 


, 5, IDVND, 6,1 5, N) 




Before: 








IDVSR 
Position 


00982 

t 1 

1 5 


IDVND ABCDE0007136673 

tttt 

Position 1 5 10 15 


N=0 








After: 








IDVSR 


is unchanged. 


IDVND ( 


)000( 


)0726 r 


r0047£ 

i 


) 


N=0 
















Position ] 


5 10 


.5 
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The numeric data field IDVND has been divided by the numeric data field ID VSR, the 
quotient and remainder being placed in IDVND. Note that the IDVND field has been 
extended to the left the length of the ID VSR field, five positions. 

Errors : If division by zero is attempted, the only action is that KCARD is extended and 
filled with zeros. The error indicator indicates that division by zero was attempted 
(NER=KLAST). 

If there is not enough room to extend the KCARD field to the left, NER will again be set 
equal to KLAST, and the routine will terminate. None of the fields involved will be 
modified. 

Remarks : Conversion from EBCDIC to decimal is necessary before using this subroutine. 
This may be accomplished with the A1DEC subroutine. 

The length of the JCARD and KCARD fields is arbitrary, up to the maximum space 
available. 

The arithmetic performed is decimal arithmetic, using whole numbers only. No decimal 
point alignment is allowed. For this reason numbers should have an assumed decimal 
point at the right-hand end. 

Space must always be provided in the KCARD field for expansion. The first position of 
the dividend, K, must be at least JLAST-J+1 positions from the beginning of KCARD, 
For example, if JCARD is seven positions, 1 through 7, the dividend in KCARD must 
start at least seven positions (7-1+1=7) from the beginning of KCARD. This would have 
K equal to 8 . 
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DPACK 

Format: CALL DPACK(JCARD, J, JLAST, KCARD, K) 

Function: Information in Dl format, one digit per word, is packed into D4 format, four 
digits per word. 

Parameter description: 

JCARD - The name of a one-dimensional integer- array defined in a DIMENSION 

statement. This array contains the data to be packed, in Dl format, one 
digit per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of JCARD to be packed (the left-hand 
end of a field) . 

JLAST - An integer constant, an integer expression, or an integer variable greater 
than J. This is the position of the last character of JCARD to be packed 
(the right-hand end of a field). 

KCARD - The name of a one-dimensional integer array defined in a DIMENSION 

statement. This is the array into which the data is packed, in D4 format, 
four digits per word. 

K - An integer constant, an integer expression, or an integer variable. This 
is the position of the first element of KCARD to receive the packed char- 
acters (the left-hand end of a field). 

Detailed description: Initially, the field to be packed (the JCARD array) is in Dl format. 
This consists 6f one digit per word, right-justified (occupying the rightmost four bits of 
the word). The sign of the field is carried with the rightmost or low -order digit. 

The operation of the DPACK subroutine is as follows: Starting at JCARD(J), and working 
from left to right, each four-bit digit of the JCARD array is placed into four bits of the 
KCARD array, four to the word, starting at KCARD(K). When JCARD(JLAST) is en- 
countered, it is assumed to be the last Dl digit, and to carry the sign of the field. The 
DPACK routine then places JCARD(JLAST), unpacked, in its entirety, into 
KCARD((JLAST-J+7)/4), the last position in the KCARD array. 
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Any unused space in the preceding KCARD word is then filled with 1 bits. This bit 
arrangement or format will be called D4 format. 

For example, suppose a seven-position JCARD array is to be packed, and it contains 1, 
2, 3, 4, 5, 6, 7: 



JCARD(l) 
JCARD(2) 
JCARD(3) 
JCARD(4) 
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JCARD(5) = 5 
JCARD(6) = 6 
JCARD(7) = 7 

JCARD(l) through JCARD(4) will be placed in KCARD(l) as 0001 0010 0011 0100. 

JCARD(5) and JCARD(6) will be placed in KCARD(2) as 0101 0110 0000 0000. 

JCARD(7) will be placed, without conversion, in KCARD(3) as 0000 0000 0000 0111. 

Then the two unused four-bit areas in KCARD(2) will be filled with Ts as 0101 0110 
1111 1111. 

More detailed information may be found in the DPACK/DUNPK flowchart and listing. 

The table below may be used to determine the number of words required for a field after 
it is packed. For example, a twelve-digit decimal field will be packed into a four-word 
field: 

• First word: 1st, 2nd, 3rd, and 4th digits 

• Second word: 5th, 6th, 7th and 8th digits 

• Third word: 9th, 10th, and 11th digits, plus four 1 bits (filler) 

• Fourth word: 12th digit carrying the sign of the field. 



Field Length 


Field Length 


Field Length 


Before 
Packing 


After 
Packing 


Before 
Packing 


After 
Packing 


Before 
Packing 


After 
Packing 


2 
3 
4 
5 


2 
2 
2 
2 


18 
19 
20 
21 


6 
6 
6 
6 


34 
35 
36 
37 


10 
10 
10 
10 


6 

7 
8 
9 


3 
3 
3 
3 


22 
23 
24 
25 


7 
7 
7 
7 


38 
39 
40 
41 


11 
11 
11 
11 


10 
11 
12 
13 


4 
4 
4 
4 


26 
27 
28 
29 


8 
8 
8 
8 


42 
43 
44 
45 


12 
12 
12 
12 


14 
15 
16 
17 


5 
5 
5 
5 


30 
31 
32 
33 


9 
9 
9 
9 


46 
47 
48 
49 


13 
13 
13 
13 
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Example: 



DIMENSION IUNPK(26),IPAKD(26) 
CALL DPACK(IUNPK, 1, 10,IPAKD, 1) 



Before: 



IUNPK 



Position 



123456789123 



10 



IPAKD ABCDEFGHIJ 



Position 



10 



After: 



IUNPK is the same, 



IPAKD 1234 5678 9FFF 0001 EFGHIJ 

Tt t t ttt 



12 3 4 5 6 10 



Position 



Errors: None 

Remarks: If JLAST is less than or equal to J, only one character of JCARD will be 
packed, and it will be treated as the sign, A multiple of four characters in JCARD will 
always be packed into KCARD. An equation for how much space is required, in ele- 
ments, in KCARD is: 



Space in KCARD = 



JLAST-J+7 



This result is rounded down at all times. 
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DUNPK 

Format: CALL, DUNPK(JC ARD, J, JLAST, KC ARD, K) 

Function: Information in D4 format, four digits per word, is unpacked into Dl format, 
one digit per word. 

Parameter description: 

JCARD - The name of a one-dimensiona^ integer array defined in a DIMENSION 
statement. This array contains the data to be unpacked, in D4 format, 
four digits per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first element of JCARD to be unpacked (the left-hand 
end of a field) . 

JLAST - An integer constant, an integer expression, or an integer variable greater 
than J. This is the position of the last element of JCARD to be unpacked, 
(the right-hand end of a field) . 

KCARD - The name of a one-dimensional integer array defined in a DIMENSION 

statement. This is the array into which the data is unpacked, in Dl for- 
mat, one digit per word. 

K - An integer constant, an integer expression, or an integer variable. This 
is the position of the first element of KCARD to receive the unpacked 
characters (the left-hand end of a field). 

Detailed description: See the detailed description of DPACK for an explanation of the Dl 
and D4 formats. 

The JCARD field, in packed (D4) format, will be unpacked (converted to Dl format) and 
placed in the KCARD field. Starting at JCARD(J), moving from left to right, each four- 
bit digit is placed in the rightmost four bits of a word in the KCARD array, starting at 
KCARD(K). 

Filler bits (four l ! s) are recognized as such and are ignored. 

JCARD(JLAST), the last word to be converted, is not altered, but is moved to 
KCARD(KLAST). KLAST cannot be calculated exactly at this point, but KLAST-K+1 
will be the same as JLAST-J+1 when the field was originally packed. In other words, 
field lengths will not be changed by a DPACK and subsequent DUNPK. 

The maximum value of KLAST can be calculated as 

4*(JLAST-J)+1 

However, it may be one, two, or three fewer positions in length. 
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More detailed information may be found in the DPACK/DUNPK flowchart and listing. 



Example: 



DIMENSION IUNPK(26),IPAKD(26) 
CALL DUNPK(IPAKD, 1, 3, IUNPK, 1) 



Before: 

IPAKD 1234 5678 0003 



IUNPK FblbLbLbbblbNbbbTbHblbSb 



I ' f 

12 3 



Position 



Position 1 



10 



After: 



IPAKD is the same. 



IUNPK 1234567 83HbIbSb 

- 1 n 



Position 1 5 10 



Errors: None 

Remarks: If JLAST is less than or equal to J, only the first element of JCARD, JCARD(J) 
will be unpacked and it will be treated as the sign. 



35- 



ADD 

A1A3 

A1DEG 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT - 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



EDIT 

Format: CALL EDIT(JCARD, J, JLAST, KCARD, K, KLAST) 

Function: Edits data from one array into another array, which contains the edit mask. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array contains the data to be edited, called the source 
field, one character per word, in Al format. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of JCARD to be edited (the left-hand 
end of afield). 

JLAST - An integer constant, an integer expression, or an integer variable, greater 
than or equal to J. This is the position of the last character of JCARD to 
be edited (the right-hand end of a field). 

KCARD - The name of a one-dimensional integer array defined in a DIMENSION 

statement. This is the array into which data is edited; it contains the edit 
mask before editing begins, stored one character per word, in Al format, 
and is called the mask field. 

K - An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of the edit mask (the left-hand end of 
afield). 

KLAST - An integer constant, an integer expression, or an integer variable, greater 
than K. This is the position of the last character of the edit mask (the 
right-hand end of a field). 

Detailed description: The following table gives the control characters for editing, the 
characters used to make up the mask, and their respective functions: 



Control Character 



Function 



b (blank) 



(zero) 



This character is replaced by a character from the 
source field. 

This character indicates zero suppression and is replaced 
by a character from the source field. The position of this 
character indicates the rightmost limit of zero suppres- 
sion (see description of operation below). Blanks are 
inserted in the high-order nonsignificant positions of 
the field. 
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Control Character 



Function 



. (decimal point) 



This character remains in the mask field where placed. How- 
ever , if zero suppression is requested, it will be removed if 
it is to the left of the last character to be zero-suppressed. 



, (comma) 



This character remains in the mask field where placed. 
However, if zero suppression is requested, it will be 
removed if it is to the left of the last character to be 
zero-suppressed. 



CR (credit) 



These two characters can be placed in the two rightmost 
positions of the mask field. They are undisturbed if the 
source field is negative. (If the source field is positive, 
the characters C and R are blanked out. ) In editing 
operations, a negative source field is indicated by an 
11-zone over the rightmost character. Whether CR is 
blanked out or not, no data will be edited into these 
positions when CR is present, but rather into the edit 
characters to the left. 



The letters C and R may be used in the remainder of 
the edit mask, where they will be treated as normal 
alphabetic characters, without being subject to sign 
control. 

Only the R character is checked, so the C character may 
be any legal character, and it will be treated as 
described. 



- (minus) 



This character is handled similarly to CR in the 
rightmost position of the mask field. 



* (asterisk) 



This character operates the same as the (zero) for 
zero suppression, except that asterisks rather than 
blanks are inserted in the high-order nonsignificant 
positions of the field, providing asterisk check 
protection. 



$ (floating dollar 
sign) 



This character has the same effect as the (zero) for 
zero suppression, except that a $ is inserted to the left 
of the first significant character found, or to the left 
of the position that stopped the zero suppression. 



The operation of the edit routine may be described in five steps: 

1. Characters are placed in the mask field from the source field, moving from right 
to left. The characters (zero) , b (blank) , * (asterisk) and $ (dollar sign) are re- 
placed with characters from the source field. No other characters in the mask 
field are disturbed. 
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2. If all characters in the source field have not been placed in the mask field before the 
end of the mask field is encountered, the whole mask is set to asterisks and editing 
is terminated. 

3. CR (credit) and - (minus) in the rightmost positions of the mask field are blanked if 
the source field is positive (does not have an 11-zone over the rightmost character). 

4. The zero suppression scan starts at the left end of the mask field and proceeds left 
to right, replacing zeros (0), blanks (b ! s), decimal points (. ), and commas (,). The 
last position replaced will occur where the zero suppression character was located, 
or one position to the left of where a significant character, not zero (0), blank (b), 
decimal point (. ), or comma (, ), occurs. If the zero suppression character was an 
asterisk (*), the replacement character is an asterisk. Otherwise, the replacement 
character is a b (blank) 9 

5. If the zero suppression character was a dollar sign ($), a dollar sign is placed in the 
last replaced position in the zero suppression scan. 

In order for the edit routine to work correctly and as described, five rules must be 
followed in creating the mask field: 

1. There must be at least as many b f s (blanks) in the mask field as characters in the 
source field. 

2. If the mask field contains zero (0), asterisk (*), or dollar sign ($), zero suppression 
will be used and the first character in the mask field must be a b (blank) . 

3. The mask field must not contain more than one of the following, which may appear 
only once: 

(zero) 
* (asterisk) 
$ (dollar sign) 

4. If the rightmost character in the mask field is an R, the next character to the left 
should be a C, in order to edit with CR (credit). Both characters will be blanked if 

the source field is positive. If the rightmost character in the mask field is - (minus), 
it will be blanked if the source field is positive. 

5. All numeric, alphabetic, and special characters may be used in the mask field. All 
characters that do not have special meaning will be left in their original position in 
the mask field during the edit. 

More detailed information may be found in the EDIT flowchart and listing. 
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Example : There are three common methods for creating a mask field such as b,bb$.bbCR: 
Method 1 Method 2 



DIMENSION MASK(IO) 
1 FORMAT(lOAl) 
IN=2 
READflN, 1)MASK 



DIMENSION MASK(IO) 

MASK(1)=16448 

MASK(2)=27456 

MASK(3)=16448 

MASK(4)=16448 

MASK(5)=23360 

MASK(6)=19264 

MASK(7)=16448 

MASK(8)=16448 

MASK(9)=-15552 

MASK(10)=-9920 



Method 3 




DIMENSION MASK(IO) 




DATA MASK/ f b , ,% ! , T b ! , , b ! , t $ t , ! .', 


! b T , T b T , ! C T , T RV 



Method 1 creates the mask by reading it from a card. Method 2 creates the mask with 
FORTRAN arithmetic statements, setting each position of the mask to the desired char- 
acter. It uses the decimal equivalents of the various EBCDIC codes, as listed in the 
APPENDIX. Method 3, using the DATA statement, is by far the shortest and simplest. 
Note that each character requires a word of core storage, regardless of the method 
employed. 
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The table of examples below illustrates how the EDIT routine works: 



Source Field 
00123D 
00123M 
00123M 
00123D 
46426723 
00200P 
082267139 
01234567 
0AB1234 
-12345 



Mask Field 
bb,bb$.bbCR 
bb,bb$obbCR 
bb,bb$.bb- 
bb,bb$.bb- 
b,bbb,bb$.bbCR 
b,bb*.bbCR 
bbb-bb-bbbb 
bbbb$.bbCR 
bbbbb$.bbCR 
bb,bb$.bb- 



Result 



bbb$12. 34bb 
bbb$12.34CR 
bbb$12. 34- 
bbb$12. 34b 
b$464,267.23bb 
***20 o 07CR 
082-26-7139 

b$AB12. 34bb 
$-,123. 45b 



Because the mask field is destroyed after each use, it is advisable to move the mask 
field to the output area and perform the edit function in the output area. 

Errors: If the number of characters in the source field is greater than the number of 
blanks in the mask field, the mask field is filled with asterisks(*). 
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FILL 

Format : CALL FILL(JCARD,J,JLAST,NCH) 

Function : Fills an area with a specified character. 

Parameter description : 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array contains the area to be filled. 

J - An integer constant, an integer expression, or an integer variable. 
This is the position of the first character of JCARD to be filled (the 
left-hand end of a field) . 

JLAST - An integer constant, an integer expression, or an integer variable, 

greater than or equal to J. This is the position of the last character of 
JCARD to be filled (the right-hand end of a field). 

NCH - An integer constant, an integer expression, or an integer variable. This 
is the code for the fill character. The Appendix contains a list of those 
codes corresponding to the EBCDIC character set; however, NCH may 
be any integer. 

Detailed description: The area of JCARD, starting with J and ending with JLAST, is 
filled with the character equivalent to the NCH code, one character per word. More 
detailed information may be found in the FILL flowchart and listing. 



Example: CALL FILL (IPRNT,3,10,16448) 

Fill the area IPRNT from positions 3 through 10 with blanks. In other words, clear the 
area. 



IPRNT: 



Before: ABCDEFGHIJKLMNOPQRSb 



After: ABbbbbbbbbKLMNOPQRSb 



Position 1 



10 



15 



20 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 
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DPACK 

DUNPK 

EDIT 
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GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



Errors: None. 
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GET 



Format: GET (JCARD, J, JLAST, SHIFT) 



Function: Extracts a data field from an array, and converts it to a real number, 
is a function subprogram. 



This 



Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array contains the data to be retrieved, stored one 
digit per word, in Al format, 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of JCARD to be retrieved (the left- 
hand end of a field). 

JLAST - An integer constant, an integer expression, or an integer variable, 

greater than or equal to J. This is the position of the last character of 
JCARD to be retrieved (the right-hand end of a field). 

SHIFT - A real constant, a real expression, or a real variable. If decimal places 
are required, SHIFT is equal to 10"^, d being the number of decimal 
places. When SHIFT is used as a scale factor, SHIFT is 10 d , d being the 
number of zeros. If a card contains 12345 and the value of SHIFT is 
0. 0001, the result will be 1. 2345. The result will be 123450. if a value 
10. is assigned to SHIFT. 

Detailed description: Using the formula 

BINARY DIGIT = (EBCDIC CODE + 4032) / 256 

the real digits are retrieved. Each binary digit is shifted left and summed, resulting in 
a whole number decimal. The sum is multiplied by SHIFT to locate the decimal point. 
The result is then placed in the real variable GET. If there are blanks in the data field, 
they are treated as zeros. If a nonnumeric character, other than blank, appears in any 
position other than the low-order position, the variable containing the result is zero. 
If a special character, other than the - (minus), appears in the low-order position, the 
resulting variable is set to zero. 

For input and for output the sign must be placed over the low-order position as an 
11-punch for minus and a 12 or no overpunch for plus. If the low-order position is zero 
and the number is negative, the column must contain only an 11-punch. (The zero must 
not be punched when FORTRAN I/O is used. ) If the low-order position is zero and the 
number is positive, the column must contain only the zero punch. (The 12 row must not 
be punched when FORTRAN I/O is used. ) 

More detailed information may be found in the GET flowchart and listing. 



■42- 



Form H20-0241-3 
Revised 10/11/68 
ByTNLN20-1888 



Example 1: DIMENSION INCRD(80) 

B=GET(INCRD,1,5,0. 001) 



Before: 



INCRD 



0123456b. . . 



Position 1 5 



After: INCRD is the same. 

B = 1. 234 (Approximately, since a fraction is present) 



Example 2: 






A 


= 


GET (INCRD, 1,6, 1.0) + GET (INCRD, 7, 12,1. 0) 




+ 


GET (INCRD, 13, 18, 1.0) + GET (INCRD, 19,24, 1. 0) 




+ 


GET (INCRD, 25, 30, 1.0) + GET (INCRD, 31,36, 1. 0) 




+ 


GET (INCRD, 37,42, 1.0) + GET (INCRD, 43, 48, 1. 0) 


Before: 






INCRD 
Position 




001221 000070 145035 700357 161111 724368 120001 270124 

t t 1 t 1 1 1 t t 

1 6 12 18 24 30 36 42 48 


After: 




INCRD is the same 

A = 2122287. (Exactly, since no fractions were generated) 



The above example sums the six-digit fields found in the first 48 columns of a card. 
Any arithmetic operation can be performed with GET () as an operand. 
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Errors: If a nonnumeric character, other than blank, appears in a position other than 
the low-order position, the result is set to zero. 

If a special character other than - (minus) appears in the low-order position, the result 
is set to zero. 

Remarks : The GET routine is a function subprogram. As such, it is used in an arith- 
metic expression as shown in the example. 

When using standard FORTRAN I/O, and the digit in the units position is a zero, a minus 
sign is shown as an 11 -punch only; a plus is shown as a zero -punch only. 

In most cases the value of SHIFT should be 1.0, placing the decimal point at the right- 
hand, end of the number. (For dollars and cents calculations, the result of the GET would 
be in cents. ) This will eliminate precision errors from the calculations. The decimal 
point may be replaced (moved to the left) with the EDIT routine for output. 

If GET (or PUT) is used, the calling program must use extended precision . 
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ICOMP 

Format : ICOMP (JCARD,J,JLAST,KCARD,K,KLAST) 

Function : Two variable-length decimal format data fields are compared. The result 
is set to a negative number, zero, or a positive number. This is a function subprogram, 

Parameter description : 

JCARD - The name of a one- dimensional integer array defined in a DIMENSION 
statement. This array contains the first data field to be compared, one 
digit per word, in decimal format. 

J - An integer constant, an integer expression, or an integer variable. 
This is the position of the first character of JCARD to be compared 
(the left-hand end of a field) . 

JLAST - An integer constant an integer expression, or an integer variable, 
greater than or equal to J. This is the position of the last character 
of JCARD to be compared (the right-hand end of a field) . 

KCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array contains the second data field to be compared, 
one digit per word, in decimal format. If the fields are unequal in 
length, the KCARD field must be the longer field. 

K - An integer constant, an integer expression, or an integer variable. 
This is the position of the first character of KCARD to be compared 
(the left-hand end of a field) . 

KLAST - An integer constant, an integer expression, or an integer variable, 
greater than or equal to K. This is the position of the last character 
of KCARD to be compared (the right-hand end of a field). 

Detailed description : Since the fields are assumed to be right-justified, the first 
operation is to examine the length of each field. If KCARD is longer than JCARD, the 
leading digits of KCARD are examined. If any one of them is greater than zero the 
result (ICOMP) is the opposite sign of KCARD. If they are all zero, or if the lengths 
are equal, corresponding digits are compared. The routine operates from left to right. 
The routine terminates when KCARD is longer than JCARD and a nonzero digit appears 
in the high-order of KCARD, when JCARD and KCARD do not match, or when all digits 
in JCARD and KCARD are equal. The following table shows the value of ICOMP, 
depending on the relation of the JCARD field to the KCARD field: 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

- ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



ICOMP 



Relation 



- (minus) 
(zero) 
+ (plus) 



JCARD is less than KCARD 
JCARD is equal to KCARD 
JCARD is greater than KCARD 
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More detailed information may be found in the ICOMP flowchart and listing. 



Example: DIMENSION ITOT(10),ICTL(10) 

IF (ICOMP(ICTL,1,10,ITOT,1,10)) 1,2,1 

The control total is compared to the total calculated. Control goes to statement 1 if the 
totals do not match (the calculated total is greater than or less than the control total) . 
Control goes to statement 2 if the calculated total is equal to the control total. The fields 
compared are not changed. 

ITOT 0007136673 

ICTL 0007136688 

ICOMP after is positive. 



Errors : No errors are detected. However, the JCARD field must not be longer than the 
KCARD field. 

Remarks : ICOMP is a function subprogram and as such should be used in an arithmetic 
expression. 

If JLAST is less than J, or KLAST is less than K, the result is unpredictable. 
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IOND 

Format; CALL IOND 

Function: Checks for I/O interrupts and loops until no I/O interrupts are pending. 

This subroutine need not be used in conjunction with Version 2 of the 1130 Disk Monitor * 
System. It (IOND) is required only for programs operating under control of Version 1 
of the Monitor. 

Detailed description: The routine checks the Interrupt Service Subroutine Counter to see 
whether any I/O interrupts are pending. If the counter is not zero, the routine continues 
to check it until it becomes zero. Then the routine returns control to the user. More 
detailed information may be found in the IOND flowchart and listing. 



Example: CALL IOND 
PAUSE 777 



The two statements shown will wait until all I/O interrupts have been serviced. Then the 
program will PAUSE. If an I/O interrupt is pending, and IOND is not used before a 
PAUSE, the program will not PAUSE. 

Errors: None 

Remarks : This statement must always be used before a STOP or PAUSE statement. 

It may also be helpful in debugging programs. Sometimes, with more than one event 
going on at the same time (PRINTing and processing) during debugging, difficulties can be 
encountered. The user may not be able to easily find the cause of trouble. The use of 
IOND after each I/O statement will ensure that only one I/O operation is going on at any 
given time. 
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KEYBD 

Format : CALL KEYBD(JCARD,J,JLAST) 

Function : Reads characters from the keyboard. 

Parameter description : 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array will contain the keyed information when reading 
is finished. The information will be in Al format, one character per 
word. 

J - An integer constant, an integer expression, or an integer variable. 

This is the position of the first word of JCARD into which a character 
will be keyed (the left-hand end of a field). 

JLAST - An integer constant, an integer expression, or an integer variable, 
greater than or equal to J. This is the position of the last word of 
JCARD into which a character will be keyed (the right-hand end of a 
field). 

Detailed description : The keyboard is read and the information being read is printed on 
the console printer. When the specified number of characters have been read, or when 
EOF is encountered, the reading terminates. The characters read are converted from 
keyboard codes to EBCDIC and placed in Al format, one character per word. Control is 
now returned to the user. More detailed information may be found in the TYPER/ 
KEYBD flowchart and listing. 



Example: DIMENSION INPUT(30) 

CALL KEYBD(INPUT,1,27) 



Before: 



INPUT ABCDEFGHIJKLMNOPQRSTUVWXYZ0123 



Position 1 



10 



15 



20 



25 30 



After: 

INPUT THE CUSTOMER NAME GOES HERE123 



Position 1 



10 



15 



20 



25 



30 



The array INPUT, from INPUT(l) to INPUT(27), has been filled 
with information read from the keyboard. 
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Errors : The following WAITs may occur: 
WAIT (loc) Accumulator (hex) 

41 2xx0 

41 2xxl 



Action 

Ready the keyboard. 

Internal subroutine error. 
Rerun job. If error persists, verify 
that the subroutine deck is accurate 
using the listing in this manual. If the 
deck is the same, contact your local 
IBM representative. Save all output. 



Only 60 characters at a time may be read from the keyboard. 

If more than 60 characters are specified (JLAST-J+1 is greater than 60), only 
60 characters will be read. 

Remarks: The characters asterisked in Appendix D of IBM 1130 Subroutine library 
(C26-5929) will be entered into core storage and printed. All other characters will 
be entered into core storage but will not be printed. 

If this subroutine is used, all other I/O must use commercial routines. 
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MOVE 

Format : CALL MOVE(JCARD,J,JLAST,KCARD,K) 

Function : Moves data from one array to another array. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This is the array from which data is moved. The data may 
be stored in JCARD in any format, one character per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of JCARD to be moved (the left -hand 
end of a field). 

JLAST - An integer constant, an integer expression, or an integer variable, 

greater than or equal to J. This is the position of the last character of 
JCARD to be moved (the right-hand end of a field). 

KCARD - The name of a one-dimensional integer array defined in a DIMENSION 

statement. This is the array to which data is moved, one character per 
word. 

K - An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of KCARD to which data will be 
moved (the left-hand end of a field). 

Detailed description: Characters are moved, left to right, from the sending field, 
.JCARD, starting with JCARD(J) and ending with JCARD(JLAST), to the receiving field 
KCARD, starting with KCARD(K). More detailed information may be found in the MOVE 
flowchart and listing. 
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Example: DIMENSION INPUT(80),IOUT(120) 
L=20 
K=14 
CALL MOVE(INPUT,6,L,IOUT,K) 



Before: 



INPUT 



IOUT 



bbbbl2ABC45ZYXPQR999Ab. . . bbbbbblbb77b6ABCDEFGHIJKLMNOPb. 



t 



<i >> ' 



t ■ i 



Position 1 5 10 15 20 Position 15 10 15 20 25 30 



After: 



INPUT is the same, 



IOUT 



bbbbbblbb77b62ABC45ZYXPQR999Pb. 



t ! t t t 



Position 15 10 15 20 25 30 

The field in the array INPUT, starting at INPUT(6) and ending at INPUT(20), is moved 
to the field in the array IOUT, starting at IOUT(14). A total of 15 characters are moved. 



Errors: None 
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MPY 

Format : CALL MPY(JCARD,J,JLAST,KCARD,K,KLAST,NER) 

Function : Multiplies two arbitrary -length decimal data fields, placing the product in the 
second data field. 

Parameter description: 

JCARD - The name of a one -dimensional integer array defined in a DIMENSION 
statement. This array is the multiplier. The data must be stored in 
JCARD in decimal format, one digit per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first digit that will multiply (the left-hand end of a 
field). 

An integer constant, an integer expression, or an integer variable, 
greater than or equal to J. This is the position of the last digit to mul- 
tiply (the right-hand end of a field). 

The name of a one -dimensional integer array defined in a DIMENSION 
statement. This array, the multiplicand, will contain the product, ex- 
tended to the left, in decimal format, one digit per word. 

K - An integer constant, an integer expression, or an integer variable. This 
is the position of the first digit of the multiplicand (the left-hand end of a 
field). 

KLAST - An integer constant, an integer expression, or an integer variable, 

greater than or equal to K. This is the position of the last character of 
the product and the multiplicand (the right-hand end of a field). 

NER - An integer variable. This variable will indicate whether the KCARD 
field is not long enough. 



JLAST - 



KCARD 



Detailed description : First the signs are cleared from both fields and saved. Then the 
KCARD field is extended to the left the length of the JCARD field ( JLAST- J+l) and filled 
with zeros. If the KCARD field will be extended below KCARD (1), NER will be set 
equal to KLAST and the routine will be terminated. Next, the JCARD field is scanned to 
find the high-order significant digit. If no digit is found, the result is set to zero. When 
a digit is found, the actual multiplication begins. The significant digits in the JCARD 
field are multiplied by the digits in the KCARD field, one at a time, starting with 
KCARD(K) and ending with KCARD(KLAST). The preliminary results are summed, 
shifting after each preliminary multiplication to give the correct place value to the pre- 
liminary results. Finally, the correct sign is generated for the result, in KCARD, and 
the sign of JCARD is restored. More detailed information may be found in the MPY 
flowchart and listing. 
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Example: DIMENSION MPLR(5),MCAND(15) 

N=0 

CALL MPY(MPLR,1,5,MCAND,6,15,N) 



Before: 



MPLR 00982 



Position 1 

N=0 



MCAND ABCDE0007136673 



Position 



i 



10 15 



After: 



MPLR is unchanged. 
N=0 



MCAND 000007008212886 



Position 



10 15 



The numeric data fields MPLR and MCAND are multiplied, the result being placed in 
MCAND. Note that the MCAND field has been extended to the left the length of the 
MPLR field, five positions, and that N has not been changed. 



Errors: If there is not enough room to extend the KCARD field to the left, NER will be 
set equal to KLAST, and the routine will terminate. 

Remarks: Conversion from EBCDIC to decimal is necessary before using this subroutine. 
This may be accomplished with the A1DEC subroutine. The length of the JCARD and 
KCARD fields is arbitrary, up to the maximum space available. 

The arithmetic performed is decimal arithmetic, using whole numbers only. 

Space must always be provided in the KCARD field for expansion. The first position of 
the multiplicand, K, must be at least JLAST-J+1 positions from the beginning of 
KCARD. For example, if JCARD is 7 positions, 1 through 7, then the multiplicand, 
in KCARD, must start at least seven positions (7-1+1=7) from the beginning of KCARD. 
This would have K equal to 8. 

The product, located in the KCARD field, will begin at position K-(JLAST-J+1) of 
KCARD, and end at position KLAST of KCARD. 
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NCOMP 

Format: NCOMP(JCARD,J,JLAST,KCARD,K) 

Function : Two variable -length data fields are compared, and the result is set to a nega- 
tive number, zero, or a positive number. This is a function subprogram. 

Parameter description: 

JCARD - The name of a one -dimensional integer array defined in a DIMENSION 
statement. This array contains the first data field to be compared, one 
character per word, in Al format. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of JCARD to be compared (the left- 
hand end of a field). 

JLAST - An integer constant, an integer expression, or an integer variable, 

greater than or equal to J. This is the position of the last character of 
JCARD to be compared (the right-hand end of a field). 

KCARD - The name of a one -dimensional, integer array defined in a DIMENSION 
statement. This array contains the second data field to be compared, 
one character per word, in Al format. 

K - An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of KCARD to be compared (the left- 
hand end of a field). 

Detailed description : Corresponding characters of JCARD and KCARD are compared 
logically, starting with JCARD(J) and KCARD(K). The routine operates from left to 
right. The routine terminates when JCARD and KCARD do not match, or when the char- 
acter at JCARD (JLAST) has been compared. The following table shows the value of 
NCOMP, depending on the relation of the JCARD field to the KCARD field: 



NCOMP 



Relation 



- (minus) 
(zero) 
+ (plus) 



JCARD is less than KCARD 
JCARD is equal to KCARD 
JCARD is greater than KCARD 



More detailed information may be found in the NCOMP flowchart and listing. 
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Example: DIMENSION IN(80) , MASTR(80) 

IF (NCOMP(IN,1,20,MASTR,1))1 9 2,3 

The field on the input card starting in column 1 and ending in column 20 is compared 
with the master field. Control goes to statement 1 if the input card is less than the mas- 
ter card. Control goes to statement 2 if the input card equals the master card. Control 
goes to statement 3 if the input card is greater than the master card. The fields com- 
pared are not changed. 

I N 1234567bbbbbbbABCDEF 

MASTR 1234567bbbbbbbABCDEF 

NCOMP after is zero 



Errors : None 

Remarks : The collating sequence in ascending order is as follows: 

A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,0,l,2,3,4,5,6,7,8,9, 

blank,., <,(, + ,&,$,*,),-,/,„ %,#,@, ! ,= 

The compare operation is terminated by the last character of the first data field, the data 
field at JCARD, or by an unequal comparison. NCOMP is a function subprogram and as 
such should be used in an arithmetic statement. 
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NSIGN 

Format : CALL NSIGN(JCARD,J,NEWS,NOLDS) 

Function : Interrogate the sign and return with a code as to what the sign is. Also, 
modify the sign as specified. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array contains the digit to be interrogated or modified, 
in decimal (Dl) format. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the digit to be interrogated or modified. 

NEWS - An integer constant, an integer expression, or an integer variable. This 
is the code specifying the desired modification of the sign. 

NOLDS - An integer variable. Upon completion of the routine, this variable con- 
tains the code specifying what the sign was. 

Detailed description: The sign is retrieved and NOLDS is set as in the table below: 

NOLDS is When the sign was 

+1 positive 

-1 negative 

Then a new sign is inserted, specified by NEWS, as shown in the table below: 



NEWS 



+1 

-1 
NOLDS 
More detailed information may be found in the NSIGN flowchart and listing. 



Sign 
positive 

opposite of old sign 
negative 
no change 
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Example: 


DIMENSION INUMB(9) 
GALL NSIGN(INUMB,9,0,N) 


Before: 


N=0, INUMB(9)=7 


After: 


N=l, INUMB(9)= -7 



Errors : None 

Remarks: The digit processed must be in decimal (Dl) format. If it is not, the results 
are meaningless. 
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NZONE 

Format : CALL NZONE (JCARD,J,NEWZ,NOLDZ) 

Function: Interrogate the zone and return with a code as to what the zone is. Also, 
modify the zone as specified. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array contains the character to be interrogated or 
modified, in Al format. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the character in JCARD to be interrogated or modified. 

NEWZ - An integer constant, an integer expression, or an integer variable. This 
is the code specifying the modification of the zone . 

NOLDZ - An integer variable. This variable contains the code specifying what the 
zone was. 

Detailed description: The zone is retrieved and NOLDZ is set as in the table below: 

NOLDZ is When the character was 

1 A-I 

2 J-R 

3 S-Z 

4 0-9 
more than 4 special 

Then a new zone is inserted, specified by NEWZ, as shown in the table below: 

NEWZ Character 

1 12 zone 



2 


11 zone 


3 


zone 


4 


no zone 


more than 4 


no change 
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When a special character is the original character, the zone will not be changed. More 
detailed information may be found in the NZONE flowchart and listing. 



Example: 


DIMENSION IN (80) 
CALL NZONE (IN,1,2,J) 


Before: 


J= 

IN(1) = a B (a 12,2 punch) 


After: 


J= 1 

IN(1) = a K (an 11,2 punch) 



Errors : None 

Remarks : The minus sign or dash (-, an 11-punch) is treated as if it were a negative 
zero, not as a special character. This is the only exception. 

The only modification performed on an input minus sign is that it may be transformed to 
a digit zero with no zone (a positive zero). 
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BAGK-/^ C 

Format : CALL Pa4k(JCARD,J, JLAST,KCARD,K) 

Function: Information in Al format, one character per word, is PACKed into A2 format, 
two characters per word. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This is the input array, containing the data in Al format, 
one character per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of JCARD to be PACKed (the left- 
hand end of a field) . 

JLAST - An integer constant, an integer expression, or an integer variable, 

greater than J. This is the position of the last character of JCARD to 
be PACKed (the right-hand end of a field). 

KCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This is the array into which the data is PACKed, in A2 for- 
mat, two characters per word. 

K - An integer constant, an integer expression, or an integer variable. This 
is the position of the first element of KCARD to receive the PACKed 
characters (the left-hand end of a field) . 

Detailed description : The characters in the JCARD array are taken in pairs, starting 
with JCARD (J), and PACKed together into one element of KCARD, starting with 
KCARD(K). Since the characters are taken in pairs, an even number of characters will 
always be PACKed. If necessary, the character at JCARD (JLAST+1) will be used in 
order to make the last data PACKed a pair. More detailed information may be found in 
the PACK/UNPAC flowchart and listing. 
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Example: DIMENSION IUNPK (26), IPAKD (26) 

CALL PACK(IUNPK,1,25,IPAKD,1) 



Before: 



IUNPK AbBbCbDbEbFbGbHblbJbKbLbMbNbObPbQbRbSbTbUbVbWbXbYbZb 



Position 



10 



15 



20 



25 



IPAKD 0blb2b3b4b5b6b7b8b9b0blb2b3b4b5b6b7b8b9b0blb2b3b4b5b 



Position 



10 



15 



20 



25 



After: 



IUNPK is the same. 

IPAKD ABCDEFGHIJKLMNOPQRSTUVWXYZ3b4b5b6b7b8b9b0blb2b3b4b5b 



Position 



10 



15 



20 



25 



Note that each two characters shown above represent one element of the array. 
Also, after IUNPK has been PACKed, the twenty-sixth character, Z, has been 
PACKed since 25 characters were specified (between J and JLAST). 



Errors : None 

Remarks : If JLAST is less than or equal to J, the first two characters of JCARD will be 
PACKed. An even number of characters in JCARD will always be PACKed into KCARD. 
An equation for how much space is required, in elements, in KCARD is 



Space in KCARD 
This result is rounded down at all times. 



[ jLAST-J+2 l 
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PRINT 

Format : CALL PRINT (JCARD, J, JLAST,NER) 

Function : The printing of one line on the IBM 1132 Printer is initiated, and control 
is returned to the user. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array contains the information to be printed, on the 
IBM 1132 Printer, in Al format, one character per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of JCARD to be printed (the left- 
hand end of a field) . 

JLAST - An integer constant, an integer expression, or an integer variable, 

greater than or equal to J. This is the position of the last character of 
JCARD to be printed (the right-hand end of a field). 

NER - An integer variable. This variable indicates carriage tape phannel con- 
ditions that have occurred in printing. 

Detailed description : When the previous print operation is finished, if a print operation 
was going on, the routine begins. The characters to be printed are packed and reversed. 
Since the characters are taken in pairs, an even number of characters is required. If 
necessary, the character at JCARD (JLAST+1) will be used to get an even number. Then 
printing is initiated and control is returned to the user. When printing is finished, the 
printer spaces one line and the indicator, NER, is set as follows: 



NER is 



when 



Channel 9 has been encountered 



4 Channel 12 has been encountered 

If channel 9 or channel 12 is not encountered, the indicator is not set. 
If a WAIT occurs at location 41, one of the following conditions exists: 



Condition 

Printer not ready or end of forms. 

Internal subroutine error. Rerun job. If 
error persists, verify that the subroutine 
deck is accurate, using the listing in this 
manual. If the deck is the same, contact 
your local IBM representative. Save all out- 
put. 



Accumulator (hex) 
6xx0 
6xxl 
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All of the above WAITs require operator intervention. 

Only one line can be printed at a time (JLAST-J+1 must be less than or equal to 120), 

More detailed information may be found in the PRINT/SKIP flowchart and listing. 



Example: DIMENSION IOUT(120) 

N=0 

CALL PRINT(IOUT,1,120,N) 
IF(N-3) 1,2,3 

2 Channel 9 routine 

3 Channel 12 routine 

1 Normal processing 

The line in IOUT, from IOUT(l) through IOUT(120), is printed. The indicator is tested 
to see whether (1) the line was printed at channel 9 or (2) the line was printed at channel 
12. Appropriate action will be taken. 

Notice that the test of the indicator is made after printing. The test should always be 



performed in this way to see where the line has just been printed. If the indicator was 



set, the line was printed at channel 9 or channel 12. 



Errors : If JLAST is less than J, only one character will be printed. If more than 120 
characters are specified (JLAST-J+1 is greater than 120), only 120 characters will be 
printed. 

Remarks : After each line is printed, the condition indicator should be checked for the 
channel 9 or channel 12 indication. In doing this the same variable should always be used 
for the indicator. 

The indicator is not reset by the subroutine. It is the responsibility of the user to initial- 
ize and reset this indicator. 

If this subroutine is used, any other I/O must use commercial subroutines, with the 
exception of disk, which must always use FORTRAN I/O. 
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PUNCH 

Format : CALL PUNCH(JCARD,J,JLAST,NER) 

Function: Punches a card on the IBM 1442, Model 6 or 7. See Subroutine P1442 for 
punching on the 1442 Model 5. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 

statement. This array contains the characters to be punched into a card, 
in Al format, one character per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of JCARD to be punched (the left- 
hand end of a field). 

JLAST - An integer constant, an integer expression, or an integer variable, 

greater than or equal to J. This is the position of the last character of 
JCARD to be punched (the right-hand end of a field). 

NER - An integer variable. This variable indicates any conditions that have 
occurred in punching a card, and the nature of these conditions. 

Detailed description: The characters to be punched are converted from EBCDIC to card 
codes, one at a time. When all characters have been converted, the punching operation 
is initiated. If an error occurs during the operation, the condition indicator is set, and 
the operation is continued. The possible values of the condition indicator and their mean- 
ing are listed below: 

NER is when 

Last card condition. 

1 Feed or punch check. 
Operator intervention 
required. 

If a WAIT occurs at location 41, one of the following conditions exists: 

Conditions Accumulator (hex) 



Punch not ready. 

Internal subroutine error. Rerun job. 
If error persists, verify that the sub- 
routine deck is accurate, using the 
listing in this manual. If the deck is 
the same, contact your IBM repre- 
sentative. Save all output. 

All of the above WAITs require operator intervention, 



lxxO 



lxxl 
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Only one card can be punched at a time (JLAST-J+1 must be less than or equal to 80) 
More detailed information may be found in the READ/PUNCH flowchart and listing. 



Example: DIMENSION IOTPT(80) 

N=-l 
CALL PUNCH(IOTPT,1,80,N) 



Before: 



IOTPT NAME . . . ADDRESS. . . AMOUNT 



Position 



20 



60 



N=-l 



After: 



IOTPT is the same. 



N=0 



The information in IOTPT, from IOTPT(l) to IOTPT(80), has been punched into a card 
Since N=0, the information was punched correctly, and the card punched into was the 
last card. 



Errors : If a punch or feed check occurs, the condition indicator will be set equal to 1. 
If an internal error occurs, the system will WAIT as specified above. 

If more than 80 characters are specified (JLAST-J+1 is greater than 80), only 80 charac- 
ters, one card, will be punched. 

Remarks : After each card is punched, the condition indicator should be checked for the 
last card indication. This will occur only after the last card has physically been 
punched. 

The condition indicator is not reset by the subroutine. It is the responsibility of the user 
to initialize and reset this indicator. 

If this subroutine is used, any other I/O must use commercial subroutines, with the ex- 
ception of disk, which must always use FORTRAN I/O. 
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PUT 

Format : CALL PUT(JCARD,J,JLAST,VAR,ADJST,N) 

Function : Converts the whole portion of a real variable, VAR, to an EBCDIC integer 
number, half-adju sting as specified, and places the result, after decimal 
point alignment, in an array. An 11-zone is placed over the low-order, 
rightmost position in the array if VAR is negative. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array will contain the result of the PUT routine, 
EBCDIC coded information, in Al format, one digit per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the first position of JCARD to be filled with the result (the left-hand 
end of a field). 



JLAST - 



VAR 



ADJST 



N 



An integer constant, an integer expression, or an integer variable, 
greater than or equal to J. This is the last position to be filled with the 
result (the right-hand end of a field). 



A real constant, a real expression, or a real variable, 
ber whose whole portion will be PUT. 

A real constant, a real expression, or a real variable, 
the variable, VAR, as a half- adjustment factor. 



This is the num- 



This is added to 



An integer constant, an integer expression, or an integer variable. This 
specifies the number of digits to truncate from the right-hand end of the 
number, VAR. 



Detailed description: First, the half- adjustment factor is added to the real variable, 
VAR. Then, each digit is retrieved using the formula 



EBCDIC DIGIT = 256 (BINARY DIGIT) - 4032 

and placed in the output area. Each binary digit is retrieved by subtracting the digits 
already retrieved from VAR and multiplying by 10. The next digit is then retrieved and 
placed in the output area. More detailed information may be found in the PUT flowchart 
and listing. 
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Example: DIMENSION IPRNT(120) 

CALL PUT(IPRNT,1,12,A,5.0,1) 



Before: 



A = 1234567. 

IPRNT ABCDE FGHIJKLMNOPQRSb 



Position 



10 



15 



20 



After: 



1234567 



IPRNT 000000123457MNOPQRSb 

f ♦ ♦ * * 

Position 1 5 10 15 20 



Errors : None 

Remarks : If the receiving field, JCARD, is not large enough to hold all of the output, 
only the low -order digits are placed. 

If JLAST is less than or equal to J, only one digit will be PUT. 

It is necessary for the programmer to use the ADJST parameter in every PUT. For 
example, assume that the number to be PUT is 123. 00. Because the IBM 1130 is a binary 
machine, the number may be represented in core storage as 122. 999. . . .If this number is 
PUT with ADJST equal to zero, the result will be 122. However, with ADJST equal to 
0. 5, the preliminary result is 123. 499; when PUT, the result is 123. The value of ADJST 
should be a 5 in the decimal position one to the right of the low -order digit to be PUT. 

The last two factors, ADJST and N, form a logical pair, and should usually appear as 
either: 



ADJST 



N 





.5 


and 





or 


5. 


and 


1 


or 


50. 


and 


2 


or 


500. 


and 


3 




etc. 




etc 



ADJST should never be less than .5, since this will introduce fraction inaccuracies, 
From this it follows that N should never be negative. 

If PUT (or GET) is used, the calling program must use extended precision. 
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P1403 



Format: CALL P1403(JCARD, J, JLAST,NER) 

Function : The printing of one line on the IBM 1403 Printer, Model 6 or 7, is initiated, 
and control is returned to the user. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array contains the information to be printed, on the 
IBM 1403 Printer, in Al format, one character per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of JCARD to be printed (the left-hand 
end of a field) . 

JLAST - An integer constant, an integer expression, or an integer variable, 

greater than or equal to J. This is the position of the last character of 
JCARD to be printed (the right-hand end of a field) . 

NER - An integer variable. This variable indicates carriage control tape condi- 
tions that have occurred in printing. 

Detailed description : When the previous print operation is finished, if a print operation 
was going on, the routine begins. The characters to be printed are converted to 1403 
Printer codes and reversed so as to match the 1403 buffer mechanism. Since the char- 
acters are taken in pairs, an even number of characters is required. If necessary, the 
character at JCARD(JLAST+1) will be used to get an even number. Printing is then 
initiated and control is returned to the user. When printing is finished, the printer spaces 
one line and the indicator, NER, is set as follows: 



NER is 



when 



Channel 9 has been encountered 



Channel 12 has been encountered 



If neither channels nor channel 12 is encountered, the indicator is not set. If a WAIT 
occurs at location 41, one of the following conditions exists: 



Conditions 



Printer not ready or end of forms, 



Accumulator (hex) 
9000 



Internal subroutine error* Rerun job. If error persists, 
verify that the subroutine deck is accurate, using the listing 
in this manual. If the deck is the same, contact your local 
IBM representative. Save all output. 

All of the above WAITs require operator intervention. 



9001 
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Only one line can be printed at a time (JLAST-J+1 must be less than or equal to 120), 
More detailed information may be found in the P1403 flowchart and listing. 



Example: DIMENSION IOUT(120) 

N=0 

CALL P1403(IOUT, l, 120, N) 
IF(N-3)1,2,3 

2 Channel 9 routine 

3 Channel 12 routine 

1 Normal processing 

The line in IOUT, from IOUT(l) through IOUT( 120), is printed. The indicator is tested 
to see whether (1) the line was printed at channel 9 or (2) the line was printed at channel 
12. Appropriate action will be taken. 

Notice that the test of the indicator is made after printing. The test should always be 
performed in this way to see where the line has just been printed. If the indicator was 
set, the line was printed at channel 9 or channel 12. 



Errors : If JLAST is less than J, two characters will be printed. If more than 120 char- 
acters are specified (JLAST-J+1 is greater than 120), only 120 characters will be printed. 

Remarks : After each line is printed, the condition indicator should be checked for the 
channel 9 or channel 12 indication. In doing this, the same variable should always be 
used for the indicator. 

The indicator is not reset by the subroutine. It is the responsibility of the user to 
initialize and reset this indicator. 

If this subroutine is used, any other I/O must use commercial subroutines, with the 
exception of disk, which must always use FORTRAN I/O. 

This CSP subroutine uses three subprograms that are part of the Disk Monitor Version 2 
subroutine library. If P1403 is to be used with Version 1 of the Monitor, ZIPCO, EBPT3, 
and PRNT3 must be loaded onto the Version 1 disk cartridge. 
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P1442 

Format: CALL P1442(JCARD, J, JLAST,NER) 

Function : Punches a card on the IBM 1442, Model 5, 6, or 7. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 

statement. This array contains the characters to be punched into a card, 
in Al format, one character per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of JCARD to be punched (the left-hand 
end of a field) . 

JLAST - An integer constant, an integer expression, or an integer variable, 

greater than or equal to J. This is the position of the last character of 
JCARD to be punched (the right-hand end of a field). 

NER - An integer variable. .This variable indicates any conditions that have 
occurred in punching a card, and the nature of these conditions. 

Detailed description: The characters to be punched are converted from EBCDIC to card 
codes, one at a time. When all characters have been converted, the punching operation 
is initiated. If an error occurs during the operation, the condition indicator is set, and 
the operation is continued. The possible values of the condition indicator and their 
meaning are listed below: 



NER is 







when 



Last card condition. 



1 Feed or punch check. Operator intervention required. 

If a WAIT occurs at location 41, one of the following conditions exists: 

Conditions Accumulator (hex) 

Punch not ready. 



Internal subroutine error. Rerun job. If error persists, 
verify that the subroutine deck is accurate, using the listing 
in this manual. If the deck is the same, contact your IBM 
representative. Save all output. 

All of the above WAITs require operator intervention. 



lxxO 
lxxl 
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Only one card can be punched at a time (JLAST- J+l must be less than or equal to 80). 
More detailed information may be found in the P1442 flowchart and listing. 



Example: DIMENSION IOTPT(80) 








N = 


-1 










CALL P1442 (IOTPT, 


1,80,N) 








Before: 












IOTPT 
Position 


NAME. . 

t 

1 


.ADDRESS. 
20 


..AMOUNT 
60 






N = -l 












After: 












IOTPT 


is the same. 










N = 


= 










The information in IOTPT, from IOTPT(l) to IOTPT(80), has been punched into a card. 
Since N = 0, the information was punched correctly, and the card punched into was the 
last card. 



Errors : If a punch or feed check occurs, the condition indicator will be set equal to 1, 
If an internal error occurs, the system will WAIT as specified above. 

If JLAST is less than J, only one character will be punched. 

If more than 80 characters are specified (JLAST- J+l is greater than 80), only 80 
characters, one card, will be punched. 

Remarks: After each card is punched, the condition indicator may be checked for the 
last-card indication. This will occur only after the last card has physically been 
punched. 

The condition indicator is not reset by the subroutine. It is the responsibility of the 
user to initialize and reset this indicator. 
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If this subroutine is used, any other I/O must use commercial subroutines, with the ex- 
ception of disk, which must always use FORTRAN I/O. 

If a program contains no calls to the READ subroutine, this routine (P1442) may be used 
to punch cards on the 1442, Model 6 or 7, at a considerable savings in core storage. 
This is due to the fact that READ and PUNCH are two different entry points to the same 
subroutine. A call to one or both will cause the READ/PUNCH routine to be added to 
the core load. P1442 is smaller in size, since it is basically the PUNCH portion of the 
READ/PUNCH routine. A program may ncrt CALL both READ/PUNCH and P1442; the 
Monitor will refuse to load two I/O routines that service the same device. To feed the 
first card, a P1442 CALL may be issued, punching 80 blanks. 

This CSP subroutine uses part of the Disk Monitor Version 2 subroutine library. If 
P1442 is to be used with Version 1 of the Monitor, PNCH1 must be loaded onto the 
Version 1 disk cartridge. 
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-RE-AD 

Format : CALL RE-AD ( JCARD, J, JLAST, NER) 

Function: Reads a card from the IBM 1442, Model 6 or 7, only, overlapping the conver- 
sion from card codes to EBCDIC. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 

statement. A card will be read into this array, in Al format, one char- 
acter per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first word of JCARD into which a character will 
be read (the left-hand end of a field). 

JLAST - An integer constant, an integer expression, or an integer variable, 
greater than or equal to J. This is the position of the last word of 
JCARD into which a character will be read (the right-hand end of a 
field). 

NER - An integer variable. This variable indicates any conditions that have oc- 
curred in reading a card, and the nature of these conditions. 

Detailed description: A card read operation is started. While the card is being read, 
the characters, one at a time, are converted from card codes to EBCDIC. If an error 
occurs during the operation, the condition indicator is set, and the operation continues. 
The possible values of the condition indicator and their meaning are listed below: 



NER is 



when 

Last card condition. 

Feed or read check. 
Operator intervention 
required. 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

— *-<fREAD 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

vVHOLE 



If a WAIT occurs at location 41, one of the following conditions exists: 

Conditions Accumulator (hex) 

lxxO 



Reader not ready. 

Internal subroutine error. Rerun job, 
If error persists, verify that the sub- 
routine deck is accurate, using the 
listing in this manual. If the deck is 
the same, contact your IBM repre- 
sentative. Save all output. 



lxxl 
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All of the above WAITs require operator intervention. 

Only one card can be read at a time (JLAST-J+1 must be less than or equal to 80). More 
detailed information may be found in the READ/PUNCH flowchart and listing. 



Example: 



DIMENSION INPUT (160) 

Nl=-1 

CALL 4e : AD(INPUT,1,80,N1) 



N2=-l 

CfcB/} O 

CALL READ(INPUT,81,160,N2) 



Before: 



INPUT 000000. . . 0000000000 
A A 



Position 1 

Nl=-1 
N2=-l 



155 160 



After: 



INPUT THIS IS THE NAME. . . SECOND CARD, 



Position 1 5 10 15 80 81 85 90 

Nl=-1 



160 



N2=-l 



From the user T s viewpoint the next card is read into the INPUT array (1-80). Nl is not 
one of the indicated values, so the first read was successful. The next card is read into 
the INPUT array (81-160). N2 is not one of the indicated values, so the second read was 
also successful. 

Errors : If a read or feed check occurs, the condition indicator will be set equal to 1. If 
an internal error occurs, the system will WAIT as specified above. 

If more than 80 characters are specified (JLAST-J+1 is greater than 80), only 80 charac- 
ters, one card, will be read. 
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Remarks : After each card read, the condition indicator may be checked for the last 
card indication. This will occur only after the last card has physically been read into 
core storage. 

The condition indicator is not reset by the subroutine. It is the responsibility of the 
user to initialize and reset this indicator. 

If this subroutine is used, any other I/O must use commercial subroutines, with the ex- 
ception of disk, which must always use FORTRAN I/O. 

Note that the READ subroutine will not detect Monitor // control cards, as opposed to 
the standard FORTRAN READ, which exits when such a card is encountered. 
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R2501 



Format ; CALL R2501(JCARD, J, JLAST, NER) 

Function: Reads a card from the IBM 2501, Model Al or A2 only, overlapping the con- 
version from card codes to EBCDIC. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 

statement. A card will be read into this array, in Al format, one char- 
acter per word. This array should always be 80 words in length. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first word of JCARD into which a character will be 
read (the left-hand end of a field). 

JLAST - An integer constant, an integer expression, or an integer variable, greater 
than or equal to J. This is the position of the last word of JCARD into 
which a character will be read (the right-hand end of a field). 

NER - An integer variable. This variable indicates any conditions that have oc- 
curred in reading a card, and the nature of these conditions. 

Detailed description : A card read operation is started. While the card is being read, 
the characters, one at a time, are converted from card codes to EBCDIC. If an error 
occurs during the operation, the condition indicator is set, and the operation continues. 
The possible values of the condition indicator and their meaning are listed below: 



NER is 



when 

Last card condition. 

Feed or read check. Operator intervention 
required. 



If a WAIT occurs at location 41, one of the following conditions exists: 



Conditions 

Reader not ready. 

Internal subroutine error. Rerun job. If 
error persists, verify that the subroutine 
deck is accurate, using the listing in this 
manual. If the deck is the same, contact 
your IBM representative. Save all output. 



Accumulator (hex) 
lxxO 
lxxl 



All of the above WAITs require operator intervention. 
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Only one card can be read at a time (JLAST-J+1 must be less than or equal to 80). More 
detailed information may be found in the R2501 flowchart and listing. 



Example: DIMENSION INPUT(160) 




Nl=-1 




CALLR2501(INPUT,1,80,N1) 




N2=-l 




CALLR2501(INPUT,81,160,N2) 




Before: 






INPUT 000000. . . 0000000000 




Position 


1 1 1 

5 155 160 




Nl=-1 






N2=-l 






After: 






INPUT THISblSbTHEbNAME . . . SECONDbCARD 

lit MM t 

Position 1 5 10 15 80 81 85 90 


1 

160 


Nl=-1 






N2=-l 







The first card is read into the INPUT array (1-80). Nl is not one of the indicated values, 
so the first read was successful. The next card is read into the INPUT array (81-160). 
N2 is not one of the indicated values, so the second read was also successful. 

Errors : If a read or feed check occurs, the condition indicator will be set equal to 1. 
If an internal error occurs, the system will WAIT as specified above. 

If more than 80 characters are specified (JLAST-J+1 is greater than 80), only 80 char- 
acters, one card, will be read. 
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Remarks: After each card read, the condition indicator may be checked for the last- 
card indication. This will occur only after the last card has physically been read into 
core storage. 

The condition indicator is not reset by the subroutine. It is the responsibility of the user 
to initialize and reset this indicator. 

If this subroutine is used, any other I/O must use commercial subroutines, with the ex- 
ception of disk, which must always use FORTRAN I/O. 

Note that the R2501 routine does not detect Monitor // control cards, as opposed to the 
standard FORTRAN READ, which exits when such a card is encountered. 

This CSP subroutine uses part of the Disk Monitor Version 2 subroutine library,, If 
R2501 is to be used with Version 1 of the Monitor, READ1 must be loaded onto the 
Version 1 disk cartridge. 
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SKIP 

Format : CALL SKIP(N) 

Function : Execute the requested control function on the IBM 1132 Printer 

Parameter description: 

N - An integer constant, an integer expression, or an integer variable. The 

value of this variable corresponds to an available control function. 

Detailed description : If the printer is busy, the subroutine WAITs. Otherwise, or when 
the printer finishes, the routine executes the requested function and returns control to 
the calling program. The control functions and their values are as follows: 



Function 
Immediate skip to channel 1 
Immediate skip to channel 2 
Immediate skip to channel 3 
Immediate skip to channel 4 
Immediate skip to channel 5 
Immediate skip to channel 6 
Immediate skip to channel 9 
Immediate skip to channel 12 
Immediate space of 1 space 
Immediate space of 2 spaces 
Immediate space of 3 spaces 
Suppress space after printing 
Normal spacing is one space after printing, 



Value 
12544 
12800 
13056 
13312 
13568 
13824 
14592 
15360 
15616 
15872 
16128 




ADD 
A1A3 
A1DEC 
A3A1 
CARRY 
DECA1 
DIV 
DPACK 
DUNPK 
EDIT 
FILL 
GET 
ICOMP 
IOND 
KEYBD 
MOVE 
MPY 
NCOMP 
NSIGN 
NZONE 
PACK 
PRINT 
PUNCH 
PUT 
P1403 
P1442 
READ 
R2501 
- SKIP 
STACK 
SUB 
S1403 
TYPER 
UNPAC 
WHOLE 



Example: NUMBR=12544 

CALL SKIP(NUMBR) 

The carriage skips until a punch in channel 1 of the carriage control tape is encountered 
(normally this is at the top of a page). 
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Errors ; Only the codes mentioned above can be used. The use of anything else will re- 
sult in either no movement of the carriage or a WAIT at location 41 with 6xxl in the 
accumulator (hex). 

Remarks: When space suppression after printing is executed, it is reset to single-space 
after printing. If the user wishes to continue suppression, he must reissue the suppres- 
sion command. 

If this subroutine is used, any other I/O must use commercial subroutines, with the ex- 
ception of disk, which must always use FORTRAN I/O. 
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STACK 



Format: CALL STACK 



Function : Selects the alternate stacker on the IBM 1442, Model 6 or 7, only for the next 
card to go through the punch station. More detailed information may be found 
in the STACK flowchart and listing. 



jExample: 


A card has been read. 


The 


sum ( 


Df the four-digit numbers in columns 10-13 


and 20-23 


is punched in columns 1-5. 


If the 


sum is negative, the card should be se- 


lected into the alternate stacker. 


A program to solve the problem follows: 




FORTRAN Statement 






Meaning 


1 


FORMAT(9X,I4,6X, 


14) 




Description of the input data. 


2 


FORMAT (15) 
10=2 






Description of the output data. 
Input unit number. 


3 


READ (10,1)11,12 

13=11+12 

IF(I3)4,5,5 






Input statement. 

Sum. 

Is the sum negative? 


4 


CALL STACK 






Yes — select the card. 


5 


WRITE (IO,2)I3 
GO TO 3 






No — punch. 

Process the next card. 




END 









Errors: None 
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P1403 
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-STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



Remarks: If the card reader is in a not-ready state (last card) and the card just read is 
to be stacker-selected, the card reader will not accept the stacker select command. The 
user should place a blank card after the card designating last card to his program. This 
will prevent the card reader from becoming not ready and will allow the card to be 
stacker- selected. 
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SUB 

Format : CALL SUB(JCARD,J,JLAST,KCARD,K,KLAST,NER) 

Function : Subtracts one arbitrary- length decimal data field from another arbitrary- 
length decimal data field, placing the result in the second data field. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This is the array that is subtracted, the subtrahend. The 
data must be stored in JCARD in decimal format, one digit per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first digit to be subtracted (the left-hand end of a 
field). 

JLAST - An integer constant, an integer expression, or an integer variable, 
greater than or equal to J. This is the position of the last digit to be 
subtracted (the right-hand end of a field). 

KCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This array, the minuend, is subtracted from, and will con- 
tain the result in decimal format, one digit per word. 

K - An integer constant, an integer expression, or an integer variable. This 
is the position of the first digit of KCARD (the left-hand end of the field). 

KLAST - An integer constant, an integer expression, or an integer variable, 

greater than or equal to K. This is the position of the last character of 
KCARD (the right-hand end of a field). 

NER - An integer variable. Upon completion of the subroutine, this variable 
will indicate whether arithmetic overflow occurred. 

Detailed description: The sign of the JCARD field is reversed and then the JCARD and 
KCARD fields are ADDed using the ADD subroutine. More detailed information may be 
found in the SUB flowchart and listing. 
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Example: DIMENSION IGRND(12), ITEM(6) 

N=0 
CALL SUB(ITEM,1,6,IGRND,1,12,N) 



Before: 
IGRND 



000713665203 



ITEM 



102342 



Position 1 5 10 

N=0 



Position 1 5 



After: 



IGRND 000713767545 



ITEM is unchanged. 



Position 1 5 

N=0 



10 



The numeric data field ITEM, in decimal format, is SUBtracted from the numeric data 
field IGRND, also in decimal format. Note that the fields are both right- justified. In 
this case, since the ITEM field is negative, and the operation to be performed is sub- 
traction, the ITEM field is added to the IGRND field. The error indicator, N, is the 
same, since there is no overflow out of the high-order digit, left-hand end, of the 
IGRND field. 

Errors : If the KCARD field is not large enough to contain the sum (that is, if there is a 
carry out of the high-order digit), the error indicator, NER, will be set equal to KLAST, 

If the JCARD field is longer than the KCARD field, nothing will be done and the error 
indicator will be equal to KLAST. 

Remarks: See the remarks for the ADD subroutine. 
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S1403 



Format: CALL S1403(N) 

Function: Execute the requested control function on the IBM 1403 Printer, Model 6 or 
7, only. 

Parameter description: 

N - An integer constant, an integer expression, or an integer variable. The value 
of this variable corresponds to an available control function. 

Detailed description: If the printer is busy, the subroutine WAIT s. Otherwise, or when 
the printer finishes, the routine executes the requested function and returns control to 
the calling program. The control functions and their values are as follows: 



Function 
Immediate skip to channel 1 
Immediate skip to channel 2 
Immediate skip to channel 3 
Immediate skip to channel 4 
Immediate skip to channel 5 
Immediate skip to channel 6 
Immediate skip to channel 7 
Immediate skip to channel 8 
Immediate skip to channel 9 
Immediate skip to channel 10 
Immediate skip to channel 11 
Immediate skip to channel 12 
Immediate space of 1 space 
Immediate space of 2 spaces 
Immediate space of 3 spaces 
Suppress space after printing 
Normal spacing is one space after printing. 



Value 
12544 
12800 
13056 
13312 
13568 
13824 
14080 
14336 
14592 
14848 
15104 
15360 
15616 
15872 
16128 
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Example : NUMBR=12544 

CALLS1403(NUMBR) 

The carriage skips until a punch in channel 1 of the carriage control tape is en- 
countered. (Normally this is at the top of a page. ) 



Errors: Only the codes mentioned above can be used. The use of anything else will re- 
sult in either no movement of the carriage or a WAIT at location 41 with 6xxl in the 
accumulator (hex). 

Remarks: When space suppression after printing is executed, it is reset to single-space 
after printing. If the user wishes to continue suppression, he must give the suppression 
command again. 

If this subroutine is used, any other I/O must use commercial subroutines, with the ex- 
ception of disk, which must always use FORTRAN I/O. 

This CSP subroutine uses three subprograms that are part of the Disk Monitor Version 2 
subroutine library. If S1403 is to be used with Version 1 of the Monitor, ZIPCO, EBPT3, 
and PRNT3 must be loaded onto the Version 1 disk cartridge. 
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TYPER 

Format : CALL TYPER(JCARD,J,JLAST) 

Function : The typing on the console printer is initiated, and control is returned to the 
user. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 

statement. This array contains the characters to be printed on the con- 
sole printer, in Al format, one character per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first character of JCARD to be printed (the left- 
hand end of a field). 

JLAST - An integer constant, an integer variable, or an integer expression, 

greater than or equal to J. This is the position of the last character of 
JCARD to be printed (the right-hand end of a field) . 

Detailed description : The characters to be printed are converted from EBCDIC to con- 
sole printer codes and are packed. Since the characters are taken in pairs, an even 
number of characters is required. If necessary, the character at JCARD (JLAST+1) will 
be used to get an even number. Then the print operation is started. While printing is in 
progress, control is returned to the user f s program. 

More detailed information may be found in the TYPER/KEYBD flowchart and listing. 



Example: 



DIMENSION IOTPT(120) 
CALL TYPER (IOTPT, 1,120) 



Before: 



IOTPT QUANTITY. . . ITEM. . . PRICE. . . AMOUNT 



MM 



Position 



20 



80 



120 



After: 

IOTPT is the same. The line is being printed. 

The printing of the line, specified in IOTPT, is initiated on the console printer, and con- 
trol returns to the user ! s program. 
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Errors: If a WAIT occurs at location 41, one of the following conditions exists: 

Condition Accumulator (hex) 

Console printer is not ready. 2xx0 

Make it ready and continue. 

Internal subroutine error. Re- 2xxl 

run job. If error persists, verify 

that the subroutine deck is accurate, 

using the listing in this manual. 

If the deck is the same, contact 

your local IBM representative. 

Save all output. 

If JLAST is less than J, two characters will be printed. If more than 120 characters are 
specified (JLAST- J+l is greater than 120), only 120 characters will be printed. 

Remarks : The asterisked characters in Appendix D of IBM 1130 Subroutine Library 
(C26-5925) are legal. No other characters will be printed. 

If this subroutine is used, any other I/O must use commercial subroutines, with the ex- 
ception of disk, which must always use FORTRAN I/O. 

Control functions can be used on the console printer. The following table indicates the 
available control functions and the decimal constant required for each function: 

Function Decimal constant 

Tabulate 1344 

Shift to black 5184 

Carrier return 5440 

Backspace 5696 

Line feed 9536 

Shift to red 13632 

The decimal constant corresponding to a particular function must be placed in the output 
area (JCARD). The function will take place when its position in the output area is 
printed. 
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Example: 


JCARD(1)=5440 

JCARD(21)=1344 

JCARD(30)=5440 

JCARD(51)=5440 

JCARD(82)=5440 

CALL TYPER (JCARD,! 


,101) 






The above coding will carrier-return to a new line, then print characters 2-20 of JCARD, 
tab to the next tab stop; print characters 22-29, carrier return, print characters 31-50, 
carrier return, print characters 52-81, carrier return, and finally print characters 
83-101. 
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UNPAC 

Format: CALL UNPAC (JCARD, J, JLAST,KCARD,K) 

Function : Information in A2 format, two characters per word, is UNPACked into Al 
format, one character per word. 

Parameter description: 

JCARD - The name of a one-dimensional integer array defined in a DIMENSION 
statement. This is the input array, containing the data in A2 format, 
two characters per word. 

J - An integer constant, an integer expression, or an integer variable. This 
is the position of the first element of JCARD to be UNPACked (the left- 
hand end of a field) . 

JLAST - An integer constant, an integer expression, or an integer variable 

greater than or equal to J. This is the position of the last element of 
JCARD to be UNPACked (the right-hand end of a field). 

KCARD - The name of a one -dimensional integer array defined in a DIMENSION 
statement. This is the array into which the data is UNPACked, in Al 
format, one character per word. 

K - An integer constant, an integer expression, or an integer variable. This 
is the position of the first element of KCARD to receive the UNPACked 
characters (the left-hand end of a field) . 

Detailed description : The characters in the JCARD array (A2) are UNPACked left to 
right, starting with JCARD(J), and placed in the KCARD array (Al), starting with 
KCARD(K). Each element of JCARD, when UNPACked, will require two elements of 
KCARD. More detailed information may be found in the PACK/UNPAC flowchart and 
listing. 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

-UNPAC 

WHOLE 
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Example: DIMENSION IUNPK(26),IPAKD(26) 

CALL UNPAC(IPAKD,1,13,IUNPK,1) 



Before: 
IPAKD 

Position 
IUNPK 

Position 



THISblNFORMATIONbWILLbUNPACKEDbbbbbbbbbbbbbbbbbbbbbb 



15 10 15 20 25 

FblbLbLbbblbNbbbTbHblbSbbbAbRbEbAbbbbbbbbbbbbbbbbbbb 



lit! 



10 



15 



20 



25 



After: 



IPAKD is the same, 



IUNPK TbHbBbSbbblbNbFbObRbMbAbTblbObNbbbWblbLbLbbbUbNbPbAb 



Position 15 10 15 20 25 

Note that each two characters shown above represent one element of the array, 



Errors : None 

Remarks : If JLAST is less than or equal to J, only the first element of JCARD,JCARD(J) 
will be UNPACked into the first two elements of KCARD. An even number of characters 
will always be UNPACked into KCARD. An equation for how much space is required, in 
elements, in KCARD is 

Space in KCARD = 2 (JLAST- J+l) 
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WHOLE 

Format : WHOLE (EXPRS) 

Function : Truncates the fractional portion of a real expression. 

Parameter description: 

EXPRS - A real expression. This is the expression that is truncated (the frac- 
tional part is made zero). 

Detailed description : The result of the expression is shifted right until the fractional 
portion has been shifted off. Then the result is shifted left to give the original result 
with a zero fraction. 



Example: 



A=WHOLE(.l*B+.5) 



Before: 



A=0. 



B=71234.99 



After: 



A=7123. 000 



B=71234.99 
The expression, (. 1*B+. 5), has been evaluated, and the fractional portion has been dropped, 



Errors : None 

Remarks : The argument, EXPRS, must always be a real expression. If the purpose is 

to simply truncate the fraction from a number A, the expression must be (1. 0*A). — *- 

If a single variable is used as an argument, the results of WHOLE are unpredictable. 
In other words, this will not work: 

A=WHOLE(B) 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 
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Note that the WHOLE function truncates the value of the argument or expression within 
the parentheses; it does not round off before truncation. For this reason, the user must 
be careful when working with fractional numbers. For example, if 

X = 1570000. 

and 

Y = WHOLE (X* . 001) 

Y will equal 1569. 000 rather than 1570. 000. This occurs because the multiplication by 
. 001 yielded 1569. 999 rather than 1570. 000. 

To avoid such a possibility, the argument for WHOLE should be half-adjusted by the user: 

Y = WHOLE (X*. 001+0. 5) 

before it is sent to WHOLE to be truncated. 
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SAMPLE PROBLEMS 

PROBLEM 1 

This program has been written to exercise many of the routines. A card is read and a 
code on that card initiates the operation of the specified routine. The card image is 
printed before execution of the routine, the resulting variable is printed and the card 
image is printed after execution of the routine. 



Switch settings are as follows: 



Input 
Device 


Output 
Device 


Switches 





1 


2 


1442 


console printer 


down 


down 


down 


1442 
1442 


1132 


up 

up 


down 
up 


down 
down 


1403 


2501 


console printer 


down 


down 


up 


2501 


1132 


up 


down 


up 


2501 


1403 


up 


up 


up 



Make sure that the switches are set properly before the program begins. 

After processing is completed, sample problem 1 will STOP with 1111 displayed in the 
accumulator. Press START to continue,, 

A general purpose *IOCS card 

*IOCS(CARD, 1132 PRINTER, TYPEWRITER) 

has been supplied with the sample problem. If this does not match the 1130 configura- 
tion to be used, a new *IOCS card will be required. 
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Sample Problem 1: Source Program 



// FOR CSP25940 

## SAMPLE PROBLEM 1 CSP25950 

« NAME SMPL1 CSP25960 

*IOCS(CARD»1132 PRINTER.TYPEWRITER) CSP25970 

• ONE WORD INTEGI *S CSP25980 

• EXTENDED PRECISION CSP25990 

• LIST ALL CSP26000 
C GENERAL PURPOSE ll30 COMMERCIAL SUBROUTINE PACKAGE TEST PROGRAM. CSP26010 

DIMENSION NCARD(eO)* NAMES(5*13) CSP26020 

FORMAT (80A1J CSP26030 

FORMAT (I10» 4F10.0, F10.3) CSP26040 
FORMAT (30H0NOW TESTING 1130 CSP ROUTINE .5A1*16H WITH PARAMETERS»CSP26050 

X4F10.3. F10.3) CSP26060 

FORMAT (13H CARD BEFORE-. 80A1) CSP26070 

FORMAT <13H CARD AFTER «»80A1) CSP26080 

F0RMAT<1H .5I3.2X.12HCARD AFTER -.1X.80A1) CSP26090 

FORMAT(1HO*4X*10HINDICATORS.3X.12HCARD BEFORE-. IX. 80A1 ) CSP26100 

FORMAT (10H ANSWER IS. F20.3) CSP26110 

—DEFINE UNIT NUMBERS OF I/O DEVICES* CSP26120 

CALL DATSW(O.N) CSP26130 

CALL DATSW(l.M) CSP26140 

CALL DATSW(2.L) CSP26150 

NREAD«6»(l/L»+2 CSP26160 

NWRIT«2*(1/NJ+2«(1/M)+1 CSP26170 

READ (NREAD.l) NAMES CSP26180 

READ (NREAD.2) N» VI. V2. V3. V4» VAR CSP26190 

IF (N) 98.98.99 CSP26200 

98 STOP 1111 CSP26210 

99 WRITE (NWRIT»3) (MAMES( I *N> . 1-1.5). VI* V2. V3. V4» VAR CSP26220 
Nl-Vl CSP26230 
N2-V2 CSP26240 
N3-V3 CSP26250 
N4-V* CSP26260 
NVAR-VAR CSP26270 
NERi-0 CSP26280 
NER2-0 CSP26290 
NER3-0 CSP26300 
NER4-0 CSP26310 
NER5-0 CSP26320 
READ (NREAD.l) NCARD CSP26330 
IF(N-7) 21.21.22 CSP26340 

21 WRITE(NWRIT»4> NCARD CSP26350 

C GO TO 1130 CSP ROUTINE CSP26360 

GO TO (11**2. 13.1A.15.16. 17)* N CSP26370 

C COMP ROUTINE CSP26380 

11 ANS«NC0MP(NCARD.N1*N2*NCARD.N3) CSP26390 
GO TO 19 CSP26400 

C MOVE ROUTINE CSP26410 

12 CALL M0VE(NCARD»N1*N2*NCARD*N3) CSP26420 
GO TO 20 CSP26A30 

C NZONE ROUTINE CSP264A0 

13 CALL NZ0NE(NCARD*N1»N2»N3) CSP26450 
ANS-N3 CSP26460 
GO TO 19 CSP26470 

C EDIT ROUTINE CSP26480 

14 CALL EDIT(NCARD*N1*N2»NCARD*N3*N4> CSP26490 



10 
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SAMPLE PROBLEM 1 



GO TO 20 
—GET ROUTINE 

ANS-GETINCARD.N1.N2.V3) 

GO TO 19 
—PUT ROUTINE 

CALL PUTJNCARD.N1.N2.VAR.V3.N4) 

GO TO 20 
—FILL ROUTINE 

CALL FILLINCARD.N1.N2.NVAR) 

GO TO 20 

WRITE INWRIT.8) ANS 

WRITE (NWRIT.5) NCARD 

GO TO 10 

WRITE(NWRIT,7) NCARD 
— A1DEC ROUTiSE 

CALL A10EC(NCAR0iNl.N2,NERl) 

CALL AlDECtNCARD.N3.N4.NER2) 

N-N-7 

GO TO (23,24.25.26.27.28) .N 
— AOO ROUTINE 

CALL ADD< NCARD. N1.N2. NCARD. N3.N4.NER3) 

GO TO 29 
—SUB ROUTINE 

CALL SUB ( NCARD. N1.N2. NCARD. N3.N4.NER3) 

GO TO 29 
— MPY ROUTINE 

CALL MPY < NCARD. N1.N2. NCARD. N3.N4.NER3 I 

GO TO 29 
— DIV ROUTINE 

CALL 01 VINCARD.N1.N2 .NCARD. N3.N4.NER3) 

GO TO 29 
—ICOMP ROUTINE 

NER3- I COMP< NCARD .N1.N2 .NCARD. N3.N4) 

GO TO 29 
— NSIGH ROUTINE 

CALL NSIGNINCARD.N1.NVAR.NER3) 
— DECA1 ROUTINE 

CALL DECAKNCARD.N1.N2.NER4) 

IF(N-3I 33.32.30 

IF(N-4) 33.31.33 

JSPAN-N2-N1 

KSPAN-N4-N3 

KSTRT-N3-JSPAN-1 

N3-N4-JSPAN 

CALL DECAK NCARD. KSTRT.N3-1.NER5) 

GO TO 33 

N3-N3-N2+N1-1 

CALL DECAKNCARD.N3.N4.NER5) 

WRITE(NWRIT.6) NER1 .NER2 .NER3 .NER4 .NER5 .NCARD 

GO TO 10 

END 



PAGE 02 

CSP26500 
CSP26510 
CSP26520 
CSP26530 
CSP26540 
CSP26550 
CSP26560 
CSP26570 
CSP26580 
CSP26590 
CSP26600 
CSP26610 
CSP26620 
CSP26630 
CSP26640 
CSP26650 
CSP26660 
CSP26670 
CSP26680 
CSP26690 
CSP26700 
CSP26710 
CSP26720 
CSP26730 
CSP26740 
CSP26750 
CSP26760 
CSP26770 
CSP26780 
CSP26790 
CSP26800 
CSP26810 
CSP26820 
CSP26830 
CSP26840 
CSP26850 
CSP26860 
CSP26870 
CSP26880 
CSP26890 
CSP26900 
CSP26910 
CSP26920 
CSP26930 
CSP26940 
CSP26950 
CSP26960 
CSP26970 
CSP26980 
CSP26990 
CSP27000 



•00F6 6 
'02 OF 14 
•028A 26 



'0101 
«021C 
'0295 



• 0111 
■0226 
'02A0 



■0126 
'0230 
■02AC 



VARIABLE ALLOCATIONS 

. V1 '2S22 *L.„"22? 3 V3 "° 006 V4 " 0009 VAR " 000C ANS • 000F NCARD-0064 NAMES-O0A5 
L -00A8 NREAD.00A9 NWRIT-OOAA I -OOAB Nl -OOAC N2 -OOAD N3 -OOAE N4 -OOAF 
NER2 -00B2 NER3 .00B3 NER4 -O0B4 NER5 -00B5 JSPAN-00B6 KSPAN-00B7 KSTRT-0088 

STATEMENT ALLOCATIONS 

1 -0OC4 2 -00C7 3 -OOCC 4 -00E8 

99 «018C 21 -01E8 11 -01FA 12 -0206 

20 -0248 22 -0251 23 -0274 24 -027F 

31 -02C6 32 -02EE 33 -02F8 

FEATURES SUPPORTED 
ONE WORD INTEGERS 
EXTENDED PRECISION 
IOCS 

CALLED SUBPROGRAMS 
DATSW NCOMP MOVE 
DECA1 ELD ESTO 
STOP CARDZ PRNTZ 

INTEGER CONSTANTS 

0-OOBA 1-OOBE 

CORE REQUIREMENTS FOR SMPL1 
COMMON VARIABLES 

END OF COMPILATION 



N 
NVAR 



■00A6 M 
•OOBO NER1 



-0177 98 
-023A 19 
-02B2 30 



»00A7 
■00B1 



• 01BA 
•0242 
•O2C0 



N20NE EDIT 
I FIX FLOAT 


GET 
WRTYZ 


PUT FILL 
SRED SWRT 


A1DEC 
SCOMP 


ADD SUB 
SFIO SIOAI 


MPY 
S10IX 


DIV ICOMP NSIGN 
SIOF SIOI SUBSC 


2-00BC 


6-00BD 


llll-OOBE 


5-OOBF 


7-OOCO 


3-00C1 


. 4-00C2 4J69-0UC9 


»L1 

> 186 PROGRAM 600 
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Form H 20-024 1-3 
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Sample Problem 1: Output 



NOW TESTING 1190 CSP ROUTINE NCOMP WITH PARAMETERS 1.000OO, 10.00000 11.00000 
CARD BEFORE-ABCDEFGHIJKLMNOPQRST 
ANSWER IS -272.000 

CARD AFTEK ■ABCDEfGHlJKLMNOPQRST 

NOW TESTING 1130 CSP ROUTINE NCOMP WITH PARAMETERS 1.00000 10.00000 11.00000 
CARD BEFORE-BCBD F BCBD F 
ANSWER IS 0.000 

CARD AFTER >BC80 F BC8D F 



NOW TESTING 1130 CSP ROUTINE NCOMP WITH 
CARD BEFORE- JKLMN 

ANSWER IS 224.000 

CARD AFTER - JKLMN 

NOW TESTING 1130 CSP ROUTINE MOVE WITH 

CARD BEFORE-ABCOE 

CARD, AFTER -ABCDE ABCDE 

NOW TESTING 1130 CSP ROUTINE MOVE WITH 

CARD BEFORE- 

CARD AFTER -9676543210 



PARAMETERS 20.00000 29.00000 
CBAFG 



CBAFG 
PARAMETERS 1.00000 5.00000 



PARAMETERS 40.00000 49.00000 
9876543210 
9876543210 



NOW TESTING 1130 CSP ROUTINE NZONE WITH PARAMETERS 10.00000 5.00000 0.00000 
CARD BEFORE- A 
ANSWER IS 1.000 

CARD AFTER > A 



0.00000 
2CSP27040 



0.00000 
4CSP27060 



4CSP27060 



0.00000 
6CSP27080 



0.00000 

8CSP27100 

8CSP27100 

0.00000 
10CSP27120 
10CSP27120 

0.00000 
12CSP27140 



NOW TESTING 1130 CSP ROUTINE NZONE WITH PARAMETERS 10.00000 5.00000 0.00000 
CARD BEFORE- I 

ANSWER IS 1.000 

CARD AFTER - I 

NOW TESTING 1130 CSP ROUTINE NZONE WITH PARAMETERS 20.00000 5.00000 0.00000 
CARD BEFORE- 

ANSWER IS 4.000 

CARD AFTER « 



0.00000 
14CSP27160 



0.00000 
16CSP271B0 



NOW TESTING 1130 CSP ROUTINE NZONE WITH PARAMETERS 20.00000 5.00000 0.00000 
CARD BEFORE- 9 

ANSWER 'IS 4.000 

CARD AFTER - 9 



NOW TESTING 1130 CSP ROUTINE NZONE WITH 

CARD BEFORE- 

ANSWER IS 2.000 

CARD AFTER « 



PARAMETERS 30.00000 5.00000 
J 



0. 00000 
18CSP27200 



0.00000 
20CSP27220 



NOW TESTING 1130 CSP ROUTINE NZONE WITH 

CARD BEFORE- 

ANSWER IS 2.000 

CARD AFTER - 



PARAMETERS 30.00000 5.00000 
R 



NOW TESTING 1130 CSP ROUTINE NZONE WITH PARAMETERS 10.00000 1.00000 



0.000*00 
22CSP27240 



22CSP27240 
0.00000 
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CARD BEFORE- 
ANSWER IS 
CARD AFTER ■ 

NOW TESTING 
CARD BEFORE" 
ANSWER IS 
CARD AFTER - 

NOW TESTING 
CARD BEFORE* 
ANSWER IS 
CARD AFTER « 

NOW TESTING 
CARD BEFORE- 
ANSWER IS 
CARD AFTER ■ 

NOW TESTING 
CARD BEFORE" 
ANSWER IS 
CARD AFTER > 

NOW TESTING 
CARD BEFORE" 
ANSWER IS 
CARD AFTER « 

NOW TESTING 
CARD BEFORE" 
ANSWER IS 
CARD AFTER - 

NOW TESTING 
CARD BEFORE- 
ANSWER IS 
CARD AFTER - 

NOW TESTING 
CARD BEFORE- 
ANSWER IS 
CARD AFTER ■ 

NOW TESTING 
CARD BEFORE" 
CARD AFTER * 

NOW TESTING 
CARD BEFORE" 
CARD AFTER » 



ROUTINE NZONE WITH PARAMETERS 
1 

4.000 
A 

ROUTINE NZONE WITH PARAMETERS 
J 

2.000 



ROUTINE NZONE WITH PARAMETERS 
I 
1.000 

9 

ROUTINE NZONE WITH PARAMETERS 
9 
4.000 

R 

ROUTINE NZONE WITH PARAMETERS 
R 
2.000 

Z 

ROUTINE NZONE WITH PARAMETERS 
D 
1.000 

U 

ROUTINE NZONE WITH PARAMETERS 
4 
4.000 



ROUTINE NZONE WITH PARAMETERS 
M 
2.000 



1130 CSP ROUTINE EDIT WITH PARAMETERS 
123456 . S. CR 

123456 Sli234.56 

1130 CSP ROUTINE EDIT WITH PARAMETERS 
02343K. , S. CR 

02343K S234.32CR 



20.00000 2.00000 0.00000 



3.00000 0.00000 



6.00000 20.00000 



1.00000 6.00000 20.00000 



24CSP27260 
24CSP27260 



O.UOUOO 
26CSP272dO 



26CSP27280 



U.UOOOO 
28CSP273U0 



2UCSP273O0 



U.UOOOO 
30CSP27320 



0.00000 
32CSP27340 



0.00000 
34CSP27360 



0.00000 
36CSP27380 



36CSP27380 



o.OOOOO 
38CSP27400 



0.00000 
40CSP27420 

40CSP27420 

30.00000 

42CSP27440 

42CSP27440 

30.00000 

44CSP27460 

44CSP27460 



NOW TESTING 1130 CSP ROUTINE EDIT WITH PARAMETERS 1.00000 6.00000 20.00000 29.00000 



CARD BEFORE-00343- 
CARD AFTER -00343- 




s. - 

$34.30- 








46CSP274U0 
46CSP27480 




NOW TESTING 1130 CSP 
CARD BEFORE-1234567 
CARD AFTER -1234567 


ROUTINE EDIT 


WITH PARAMETERS 
S. 


1.00000 


7.00000 


21.00000 


2a. ooooo 

48CSP27500 
48CSP275O0 


0.000 


NOW TESTING 1130 CSP 
CARD BEFORE-00005M 
CARD AFTER -00005M 


ROUTINE EDIT WITH PARAMETERS 
.* . CR 

##«##*****#*»»00.54CR 


1.00000 


6.00000 


10.00000 


30.00000 

50CSP27520 

50CSP27520 


0.000 


NOW TESTING 1130 CSP 
CARD BEFORE- 5M 
CARD AFTER « 5M 


ROUTINE EDIT WITH PARAMETERS 
tO . - 
••* .54- 


1.00000 


6.00000 


20.00000 


29.00000 

52CSP27540 

52CSP27540 


o.ouo 


NOW TESTING 1130 CSP 
CARD BEF0RE-12345 
ANSWER IS 
CARD AFTER -12345 


ROUTINE GET 
123.449 


WITH PARAMETERS 


1.00000 


5.00000 


0.01000 


0.00000 
54CSP27560 

54CSP27560 


0.000 


NOW TESTING 1130 CSP 
CARD BEF0RE-1234N 
ANSWER IS 
CARD AFTER -1234N 


ROUTINE GET 
-123.449 


WITH PARAMETERS 


1.00000 


5.00000 


0.01000 


0.00000 
56CSP27580 

56CSP275B0 


0.000 


NOW TESTING 1130 CSP 
CARD BEFORE-1 3 5 7 
ANSWER IS 
CARD AFTER -13 5 7 


ROUTINE GET 
1030.506 


WITH PARAMETERS 


1.00000 


7.00000 


0.00100 


O.UOOOO 
58CSP27600 

58CSP27600 


0.000 


NOW TESTING 1130 CSP 
CARD BEF0RE-12AB4 
ANSWER IS 
CARD AFTER -12AB4 


ROUTINE GET 
0.000 


WITH PARAMETERS 


1.00000 


5.00000 


1.00000 


0.00000 
60CSP27620 

60CSP27620 


0.000 


NOW TESTING 1130 CSP 
CARD BEFORE-1230- 
ANSWER IS 
CARD AFTER -1230- 


ROUTINE GET 
12300.000 


WITH PARAMETERS 


1.00000 


5.00000 


1.00000 


0.00000 
62CSP27640 

62CSP27640 


o.ooo 


NOW TESTING 1130 CSP 
CARD BEFORE-123 
ANSWER IS 
CARD AFTER -123 


ROUTINE GET 
0.001 


WITH PARAMETERS 


1.00000 


3.00000 


0.00001 


0.00000 
64CSP27660 

64CSP27660 


0.000 


NOW TESTING 1130 CSP 
CARD BEFORE- 
CARD AFTER -12343 


ROUTINE PUT 


WITH PARAMETERS 


1.00000 


5.00000 


0.30000 


0.00000 12343.000 
66CSP27680 
66CSP27680 


NOW TESTING 1130 CSP ROUTINE PUT 
CARD BEFORE- 
CARO AFTER -89 


WITH PARAMETERS 


1.00000 


2.00000 


5.00000 


1.00000 12890.000 
68CSP27700 
68CSP27700 


NOW TESTING VHO CSP 


ROUTINE PUT 


WITH PARAMETERS 


11.00000 


15.00000 


3.00000 


1.00000 12345.000 
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CARD BEFORE* 

CARD AFTER » 01235 

NOW TESTING 1130 CSP ROUTINE PUT 

CARD BEFORE* 

CARD AFTER - 0000340 

NOW TESTING 1130 CSP ROUTINE PUT 

CARD BEFORE* 

CARD AFTER * OOOOOOOK. 

NO* TESTING 1130 CSP ROUTINE FILL 
CARD BEFORE-ABCDcFGHIJK. 
CARD AFTER * K 



WITH PARAMETERS 10.00000 16.00000 50.00000 



WITH PARAMETERS 10.00000 17.00000 



WITH PARAMETERS 1.00000 10.00000 



NOW TESTING 1130 CSP ROUTINE FILL WITH PARAMETERS 
CARD BEFORE* ABCDEFGH 

CARD AFTER ■ A$$$$i$H 



20.00000 25.00000 0.00000 



70CSP27720 
70CSP27720 

2. 00000-34567. OUU 
72CSP27740 
72CSP27740 

1.00000 -16.000 
74CSP27760 
74CSP27760 

u. 00000 16448.000 
76CSP27780 
76CSP27760 

0.00000 23360. 000 
7BCSP27800 
7oCSP27800 



NOW TESTING 1130 CSP ROUTINE ADD WITH PARAMETERS 31.00000 35.00000 66.00000 70.00000 



CARD BEFORE* 
CARD AFTER • 



24 

00024 



NOW TESTING 1130 CSP ROUTINE SUB WITH PARAMETERS 31.00000 35.00000 66.00000 70.00000 



INDICATORS 




CARD BEFORE* 
CARD AFTER « 



24 

00024 



204S 
02072 



2048 
02024 



NOW TESTING 1130 CSP ROUTINE MPY WITH PARAMETERS 31.00000 35.00000 66.00000 7u. 00000 



INDICATORS 




CARD BEFORE* 
CARD AFTER » 



24 
00024 



2048 
0000049152 



NOW TESTING 1130 CSP ROUTINE DIV WITH PARAMETERS 31.00000 35.00000 66.00000 70.00000 



INDICATORS 
00 



CARD BEFORE* 
CARD AFTER * 



24 
00024 



2048 
0008500008 



CSP27020 
CSP27820 



CSP27B40 
C6P27840 



CSP27860 
CSP27860 



CSP2708O 
CSP27880 



NOw TESTING 1130 CSP ROUTINE ICOMP WITH PARAMETERS 31.00000 35.00000 66.00000 70.00000 



INDICATORS 
0-600 



CARD BEFORE- 
CARD AFTER * 



24 
00024 



NOW TESTING 1130. CSP ROUTINE NSIGN WITH PARAMETERS 1.00000 1.00000 2.00000 2.00000 

INDICATORS CARD BEFORE- 65 
10 CARD AFTER - 65 

NOW TESTING 1130 CSP ROUTINE ADD WITH PARAMETERS 31.00000 35.00000 66.00000 70.00000 



2048 
02048 



CSP27900 
CSP27900 



CSP27920 
CSP27920 



INDICATORS 




CARD BEFORE- 
CARD AFTER - 



99 
00099 



NOW TESTING 1130 CSP ROUTINE SOB WITH PARAMETERS 31.00000 35.00000 66.00000 



INDICATORS 




CARD BEFORE- 
CARD AFTER ■ 



99 

00099 



NOW TESTING 1130 CSP ROUTINE MPY WITH PARAMETERS 31.00000 35.00000 66.00000 70.00000 



2048 
02147 



2048 
01V49 



CSP27940 
CSP27940 



CSP27960 
CSP27960 



INDICATORS CARD BEFORE" 
CARD AFTER ■ 



99 
00099 



2048 
0000202752 



CSP27960 
CSP279B0 



NOW TESTING 1130 CSP ROUTINE DIV WITH PARAMETERS 31.00000 35.00000 66.00000 7o.uO0OO 



INDICATORS 




CARD BEFORE- 
CARD AFTER - 



99 

00099 



2048 
0002000068 



CSP28000 
CSP28000 



NOW TESTING 1130 CSP ROUTINE ICOMP WITH PARAMETERS 31.00000 35.00000 66.00000 70.00000 



INDICATORS 
0-900 



CARD BEFORE* 
CARD AFTER « 



99 
00099 



2048 
0204e 



CSP2B020 
CSP28020 



NOW TESTING 1130 CSP ROUTINE NSIGN WITH PARAMETERS 1.00000 1.00000 



INDICATORS 
10 



CARD BEFORE' 
CARD AFTER • 



NOW TESTING 1130 CSP ROUTINE ADD WITH PARAMETERS 1.00000 20.00000 41.00000 



csp*:ao40 

CSP2B040 



INDICATORS 




CARD BEFORE- 12345678901234567890 
CARD AFTER - 12345678901234567890 



123456789012345678901234567890 
123456789024691357802469135 780 



CSP2d060 
CSP28060 



NOW TESTING 1130 CSP ROUTINE SUB WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 



INDICATORS 




CARD BEFORE- 12345678901234567890 
CARD AFTER « 12345678901234567890 



1234567d90123456789012345b7690 
123456789000OO00O000u00ooo^uOu 



CSP26000 
CSP28U80 



NOW TESTING 1130 CSP ROUTINE MPY WITH PARAMETERS 1.00000 20.00000 41.00000 7o. 



INDICATORS CARD BEFORE* 12345678901234567890 



123456789012345678901234567890 



CARD AFTER ■ 123456789012345673900l524l57B753238836750342935775019O5199B750i9o5210O 

NOW TESTING 1130 CSP ROUTINE DIV WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 O.*00 

INDICATORS CARD BEFORE* 12345678901234567890 123456789012345678901234567690 

3 CARD AFTER * 123456789012345678900000000000o0ojju0u0l 0uJ0o0o0o0o00u000000l234367890 

NO* TESTING 1130 CSP ROUTINE ICOMP WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 0.000 



CSP20100 
CSP^BlOO 



CiP28120 
CSP2B120 



INDICATORS 
0-100 



CARD BEFORE" 
CARD AFTER " 



12345678901234567890 
12345678901234567890 



NOW TESTING 1130 CSP ROUTINE NSIGN WITH PARAMETERS 
INDICATORS CARD BEFORE- 32 



123456789012345678901234bb7B90 
123456789012 345678901234567890 



CSP26140 
CSP28140 



■98- 



10 
NOW TESTING 1130 



CARD AFTER ■ 
CSP ROUTINE 



| L2 

AOO 



WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 



INDICATORS 




CARD BEFORE" 
CARD AFTER ■ 



1234567890123456789- 
1234567890123456789- 



123456789012345678901234567690 
1234567890000000OO00O00000OU0O 



NOW TESTING 1130 CSP ROUTINE SUB WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 



INDICATORS 




CARD BEFORE" 
CARD AFTER « 



1234567890123456789- 
1234567890123456789- 



123456789012345678901234567890 
123456789024691357802469135780 



NOW TESTING 1130 CSP ROUTINE MPY WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 



INDICATORS 




CARD BEFORE' 
CARD AFTER • 



1234567890123456789- 



123456789012345678901234567890 



' 1234567890123456789-0152415787532388367503429357750190519987501905210- 
NOW TESTING 1130 CSP ROUTINE DIV WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 0.000 



INDICATORS 




CARD BEFORE" 
CARD AFTER « 



1234567890123456789- 123456789012345678901234567890 

12 345678 90 12 34 5 67 89-00000000000000000001000000000-00000 000001 23456 7B90 



NOW TESTING 1130 CSP ROUTINE ICOMP WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 



INDICATORS 
0-1 C 



CARD BEFORE" 
CARD AFTER « 



1234567890123456789- 
1234567890123456789- 



123456789012345678901234567890 
123456789012345678901234567O90 



NOW TESTING 1130 CSP ROUTINE NSIGN WITH PARAMETERS 1.00000 1.00000 



INDICATORS 
0-100 



CARD BEFORE" 
CARD AFTER . 



NOW TESTING 1130 CSP ROUTINE ADD WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 



INDICATORS 




CARD BEFORE" 
CARD AFTER = 



12345678901234567890 
12345678901234567890 



12345678901234567890123456789- 
1 2345678900000000000 OOOOOOoOO- 



NOW TESTING 1130 CSP ROUTINE SUB WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 



INDICATORS 




CARD BEFORE" 
CARD AFTER ■ 



12345678901234567890 
12345678901234567890 



123456789012 34567890123456789- 
12345678902469135780246913578- 



NOW TESTING 1130 CSP ROUTINE MPY WITH PARAMETERS 1.00000 20.00000 41.00000 7O.OJO00 



INDICATORS 




CARD BEFORE" 
CARD AFTER « 



12345678901234567890 



12345678901234567890123456789- 



■■ 123456789012345678900152415787532388367503429357750190519987501905210- 
NOW TESTING 1130 CSP ROUTINE DIV WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 0.000 



INDICATORS 




CARD BEFORE" 
CARD AFTER = 



12345678901234567890 12345678901234567890123456789- 

1234567890 1234567890000000000000 J0000O010OOO0O0OO-OOOO00O00O123456789- 



NOw TESTING 1130 CSP ROUTINE ICOMP WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 



CSP2818C 
CSP28180 



CSP28200 
CSP28200 



CSP28220 
CSP28220 



CSP28240 
CSP28240 



CSP28260 
CSP28260 



CSP28280 
CSP28280 



CSP28300 
CSP28300 



CSP28320 
CSP28320 



CSH28340 
CSP28340 



CSP28360 
CSP28360 



Form H 20-024 1-3 
Revised 10/11/68 
ByTNLN20-1888 



INDICATORS 




CARD BEFORE" 
CARD AFTER « 



12345678901234567890 
12345678901234567890 



12345678901234567890123456789- 
12345678901234567890123456789- 



CSP28J80 
CSP28J80 



NOW TESTING 1130 CSP ROUTINE NSIGN WITH PARAMETERS 1.00000 1.00000 2.00000 2.00000 



INDICATORS 
0-100 



CARD BEFORE" NM 
CARD AFTER ■ NM 



CSP28400 
CSP2B400 



NOW TESTING 1130 CSP ROUTINE ADD WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 



INDICATORS 




CARD BEFORE" 
CARD AFTER « 



1234567890123456789- 
1234567890123456789- 



12345678901234567890123456789- 
12345678902469135780246913578- 



NOW TESTING 1130 CSP ROUTINE SUB WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 



CSP28420 
CSP28420 



INDICATORS 




CARD BEFORE" 1234567890123456789- 
CARD AFTER - 1234567890123456789- 



12345678901234567890123456789- 
12345678900000000000000000000- 



CSP28440 
CSP28440 



NOW TESTING 1130 CSP ROUTINE MPY WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 



INDICATORS 




CARD BEFORE- 1234567890123456789- 



12345678901234567890123456789- 



CARD AFTER ■ 1234567890123456789-01524157875323883675034293577501905199875019052100 
NOW TESTING 1130 CSP ROUTINE DIV WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 0.000 



CSP28460 
C6P28460 



INDICATORS 




CARD BEFORE" 1234567890123456789- 12345678901234567890123456789- 

CARD AFTER ■ 1234567890123456789-000000000000oo000O0lo0OOo00000000OO00000l23456789- 



NOW TESTING 1130 CSP ROUTINE ICOMP WITH PARAMETERS 1.00000 20.00000 41.00000 70.00000 



INDICATORS 




CARD BEFORE" 
CARD AFTER ■ 



1234567890123456789- 
1234567890123456789- 



12345678901234567890123456789- 
12345678901234567890123456789- 



NOW TESTING 1130 CSP ROUTINE NSIGN WITH PARAMETERS 1.00000 1.00000 2.00000 2.00000 



CSP28480 
CSP28480 



CSP28500 
CSP28500 



INDICATORS 
0-100 



CARD BEFORE- ML 
CARD AFTER - 4L 



CSP28520 
CSP28520 



NOW TESTING 1130 CSP ROUTINE ADD WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 



INDICATORS 




CARD BEFORE* 
CARD AFTER « 



12345678901234567890 
12345678901234567890 



12345678901234567890 
24691357802469135780 



NOW TESTING 1130 CSP ROUTINE SUB WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 



INDICATORS 




CARD BEFORE" 
CARD AFTER > 



12345678901234567890 
12345678901234567890 



12345678901234567890 

OOOOOOUOOOOOOOOOUOuu 



NOW TESTING 1130 CSP ROUTINE MPY WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 



INDICATORS 




CARD BEFORE- 12345678901234567890 
CARD AFTER - 12345678901234567890 



12345678901234567890 
O152415787532388367501905199875O190521OO 



CSP28540 
CSP28540 



CSP2B560 
CSP28560 



C6P28580 
CSP2b380 



TESTING 1130 CSP ROUTINE DIV WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 



-99- 



Form H20-0241-3 
Revised 10/11/68 
By TNL N20-1888 



INDICATORS 




CARD 6EF0RE" 
CARD AFTER » 



1234567890123*567890 
12345678901234567890 



12345676901234567890 

OOOOOOOOOOOOOOOOOOOlOOOoOOOOOOoOOOOOOOOO 



CSP28600 
CSP28600 



NOW TESTING 1130 CSP ROUTINE ICOMP WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 0.000 



INDICATORS 




CARD BEFORE' 
CARD AFTER « 



12345678901234567890 
12345678901234567890 



12345678901234567890 
12345678901234567890 



CSP28620 
CSP28620 



NOW TESTING 1130 CSP ROUTINE NSIGN WITH PARAMETERS 1.00000 1.00000 2.00000 2.00000 1.000 



INDICATORS 
0-1 



CARD BEFORE' 
CARD AFTER » 



CSP28640 
CSP28640 



NOW TESTING 1130 CSP ROUTINE ADD WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 O.000 



INDICATORS 




CARD BEFORE" 
CARD AFTER « 



1234567890123456789- 
1234567890123456789- 



12345678901234567890 

0000000000 JOOOOOOOOO 



CSP28660 
CSP28660 



NOW TESTING 1130 CSP ROUTINE SUB WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 0.000 



INDICATORS 




CARD BEFORE" 
CARD AFTER • 



1234567890123456789- 
1234567890123456789- 



12345678901234567890 
24691357802469135780 



CSP28680 
CSP28680 



NOW TESTING 1130 CSP ROUTINE MPY WITH PARAMETERS 1.00000 20.00000 51.00oOO 70.00000 0.000 



INDICATORS 




CARD BEFORE' 
CARD AFTER » 



1234567890123456789- 
1234567890123456789- 



12345678901234567890 
015241578753238836750190519987501905210- 



NOW TESTING 1130 CSP ROUTINE DIV WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 0.000 



INDICATORS 




CARD BEFORE. 
CARD AFTER ■ 



1234567890123456789- 
1234567890123456789- 



12345678901234567890 

OOOOOOOOOOOOOOOOOOOJOOOOOOJOOOoOOOUOOOOO 



CSP28700 
CSP28700 



CSP28 720 
CSP28720 



NOW TESTING 1130 CSP ROUTINE ICOMP WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 0.000 



INDICATORS 
0*»* 



CARD BEFORE' 
CARD AFTER » 



1234567890123456789- 
1234567890123456789- 



12345678901234567890 
12345678901234567890 



NOW TESTING 1130 CSP ROUTINE NSIGN WITH PARAMETERS 1.00000 1.00000 2.00000 2.00000 -1.000 



INDICATORS 
0-100 



CARD BEFORE" 
CARD AFTER « 



NOW TESTING 1130 CSP ROUTINE ADD WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 0.000 



INDICATORS 




CARD BEFORE. 
CARD AFTER • 



12345678901234567890 
12345678901234567890 



1234567890123456789- 

OOOOOOOOOOOOOOOOoOO- 



NOW TESTING 1130 CSP ROUTINE SUB WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 0.000 



INDICATORS 




CARD BEFORE' 
CARD AFTER • 



12345678901234567890 
12345678901234567890 



1234567890123456789- 
2469135780246913578- 



CSP28740 
CSP28740 



CSP28760 
CSP28760 



CSP28780 
CSP28780 



CSP26800 
CSP28800 



NOW TESTING 1130 CSP ROUTINE MPY WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 0.000 



INDICATORS 




CARD BEFORE* 
CARD AFTER « 



12345678901234567890 
12345678901234567890 



1234567890123456789- 
015241578753238836750190519987501905210- 



NOW TESTING X130 CSP ROUTINE DIV WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 



INDICATORS 




CARD BEFORE' 
CARD AFTER > 



12345678901234567890 
12345678901234567890 



1234567890123456789- 

OOOOOOOOOOUOOOOOOOOJOOUOOOJOOOuOOOOOOOO- 



NOW TESTING 1130 CSP ROUTINE ICOMP WITH PARAMETERS 1.00000 20.00000 51.00000 7u.00p00 



INDICATORS 
0»»« 



CARD BEFORE' 
CARD AFTER « 



12345678901234567890 
12345678901234567890 



1234567890123456789- 
1234567890123456789- 



NOW TESTING 1130 CSP ROUTINE NSIGN WITH PARAMETERS 1.00000 1.00000 2.00000 2.00000 



INDICATORS 
0-100 



CARD BEFORE' 
CARD AFTER « 



NOW TESTING 1130 CSP ROUTINE ADD WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 



INDICATORS 




CARD BEFORE. 
CARD AFTER > 



1234567890123456769- 
1234567890123456789- 



1234567890123456789- 
2469135780246913578- 



NOW TESTING 1130 CSP ROUTINE SUB WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 



INDICATORS 




CARD BEFORE* 
CARD AFTER ■ 



1234567890123456789- 
1234567890123456789- 



1234567890123456789- 
OOOOOOOOOOOOOOOOOOU- 



NOW TESTING 1130 CSP ROUTINE MPY WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 



INDICATORS 




CARD BEFORE" 
CARD AFTER ■ 



1234567890123456789* 
1234567890123456789- 



1234567890123456789- 
0152415787532388367501905199875019052100 



CSP28U20 
CSP28U20 



C6P28840 
CSP28840 



C&P28860 
CSP^8tJ60 



CSP28880 
CSP28880 



CSP28900 
CSP28900 



CSP28920 
CSP28920 



CSP28940 
CSP28940 



NOW TESTING 1130 CSP ROUTINE DIV WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 



INDICATORS 




CARD BEFORE* 
CARD AFTER « 



1234567890123456789- 
1234567890123456789- 



12345678901234567O9- 
OOOOOOOOOOOOOUOOOOolOOOOOOOOOOwOOOOOOOO- 



NOW TESTING 1130 CSP ROUTINE ICOMP WITH PARAMETERS 1.00000 20.00000 51.00000 70.00000 



INDICATORS 




CARD BEFORE- 
CARD AFTER • 



1234567890123456789- 
1234567890123456789- 



1234567890123456789- 
1234567890123456789- 



CSP28960 
CSP28960 



CSP28980 
CSP289B0 



-100- 



Sample Problem 1: Data Input Listing 



// XEO 
















CSP27010 


NCOMPMOVE NZONEEOIT GET 


PUT FILL 


ADO SUB 


MPY DIV ICOMPNSIGN CSP27020 




1 


1 






10 


11 




1CSP27030 


ABCDEFGHIJI 












2CSP27040 




1 


1 






10 


11 




3CSP27050 


BC8D F 


BC8D F 














4CSP27060 




1 


20 






25 


30 




5CSP27070 






JKLMN 


CBAFG 






6CSP27080 




2 


1 






5 


20 




7CSP27090 


ABCDE 
















8CSP27100 




2 


40 






49 


1 




9CSP27110 














9876543210 


10CSP27120 




3 


10 






5 






11CSP27130 




A 














12CSP27140 




3 


10 






5 






13CSP27150 




I 














14CSP27160 




3 


20 







5 






15CSP27170 
16CSP27180 




3 


20 
9 






5 






17CSP27190 
18CSP27200 




3 


30 






5 

J 






19CSP27210 
20CSP2722O 




3 


30 






5 
R 






21CSP27230 
22CSP27240 




3 


10 






1 






23CSP27250 




A 














24CSP27260 




3 


10 






1 






25CSP27270 




1 














26CSP27280 




3 


10 






1 






27CSP27290 




J 














28CSP27300 




3 


20 
I 






4 






29CSP27310 
30CSP27320 




3 


20 
9 






2 






31CSP27330 
32CSP27340 




3 


20 
R 






3 






33CSP27350 
34CSP27360 




3 


30 






3 








35CSP27370 
36CSP27380 




3 


30 






2 






37CSP27390 
38CSP27400 




3 


30 






4 
M 






39CSP27410 
40CSP27420 




4 








6 


20 


30 


41CSP27430 


123456 






» 


S. 


CR 






42CSP27440 




4 








6 


20 


30 


43CSP27450 


02343K 






» 


s. 


CR 






44CSP27460 




4 








6 


20 


29 


45CSP27470 


00343- 






* 


s. 


- 






46CSP27480 




4 








7 


21 


28 


47CSP27490 


1234567 






* 


*. 








48CSP27500 




4 " 








6 


10 


30 


49CSP27510 


00005M 






»• 


• 


CR 






50CSP27520 




4 








6 


20 


29 


51CSP27530 


5M 


5 




»0 


• 


5 


.01 




52CSP27540 
53CSP27550 


12345 


5 








5 


.01 




54CSP27560 
55CSP27570 


1234N 


5 








7 


.001 




56CSP27580 
57CSP27590 


13 5 7 
















58CSP27600 



101- 



5 




5 


12AB4 






5 




5 


1230- 






5 




3 


123 






6 




5 


6 




2 


6 


H 


15 


6 


10 


16 


6 


10 


17 


7 


1 


10 


ABCDEFGHIJK 






7 


20 
ABCOEFGH 


25 


08 


31 


35 


09 


31 


35 


10 


31 


35 


11 


31 


35 


12 


31 


35 


13 


1 


1 


65 






08 


31 


35 


09 


31 


35 


10 


31 


35 


11 


31 


35 


12 


31 


35 


13 


1 


1 


54 






08 


01 


20 


12345678901234567890 




09 


01 


20 


12345678901234567890 




10 


01 


20 


12345678901234567890 




11 


01 


20 


12345678901234567890 




12 


01 


20 


12345678901234567890 




13 


1 


1 


32 






08 


01 


20 



12890. 



16448. 
23360. 



70 



41 70 

123456789012345678901234567890 
41 70 

123456789012345678901234567890 
41 70 

123456789012345678901234567890 
41 70 

123456789012345678901234567890 
41 70 

123456789012345678901234567890 
2 2 



41 



70 



59CSP27610 

60CSP27620 

61CSP27630 

62CSP27640 

63CSP27650 

64CSP27660 

65CSP27670 

66CSP27680 

67CSP27690 

68CSP27700 

69CSP27710 

70CSP27720 

71CSP27730 

72CSP27740 

73CSP27750 

74CSP27760 

75CSP27770 

76CSP27780 

77CSP27790 

78CSP27800 

CSP27810 

CSP27820 

CSP27830 

CSP27840 

CSP27850 

CSP27860 

CSP27870 

CSP27880 

CSP27890 

CSP27900 

CSP27910 

CSP27920 

CSP27930 

CSP27940 

CSP27950 

CSP27960 

CSP27970 

CSP27980 

CSP27990 

CSP28000 

CSP28010 

CSP28020 

CSP28030 

CSP28040 

CSP28050 

CSP28060 

CSP28070 

CSP28080 

CSP28090 

CSP28100 

CSP28110 

CSP28120 

CSP28130 

CSP28140 

CSP28150 

CSP28160 

CSP2817C 



-102- 



1234567890123456789- 

09 01 
1234567890123456789- 

10 01 
1234567890123456789- 

11 01 
1234567890123456789- 

12 01 
1234567890123456789- 

13 1 
ON 

08 01 
12345678901234567890 

09 01 
12345678901234567890 

10 01 
12345678901234567890 

11 01 
12345678901234567890 

12 01 
12345678901234567890 

13 1 
NM 

08 01 
1234567890123456789- 

09 01 
1234567890123456789- 

10 01 
1234567890123456789- 

11 01 
1234567890123456789- 

12 01 
1234567890123456789- 

13 1 
ML 

08 01 
12345678901234567890 

09 01 
12345678901234567890 

10 01 
12345678901234567890 

11 01 
12345678901234567890 

12 01 
12345678901234567890 

13 1 
-0 

08 01 
1234567890123456"»89- 

09 01 
1234567890123456789- 

10 01 
1234567890123456789- 

11 01 
1234567890123456789- 

12 01 
1234567890123456789- 

13 1 
-0 

08 01 
12345678901234567890 



20 


41 


20 


41 


20 


41 


20 


41 


1 


2 


20 


41 


20 


41 


20 


41 


20 


41 


20 


41 


1 


2 


20 


41 


20 


41 


20 


41 


20 


41 


20 


41 


1 


2 


20 


51 


20 


51 


20 


51 


20 


51 


20 


51 


1 


2 


20 


51 


20 


51 


20 


51 


20 


51 


20 


51 


1 


2 


20 


51 



123456789012345678901234567890 

70 
123456789012345678901234567890 

70 
123456789012345678901234567890 

70 
1234567 89012345678901234567890 

70 
123456789012345678901234567890 
2 1. 

70 
12345678901234567890123456789- 

70 
12345678901234567890123456789- 

70 
12345678901234567890123456789- 

70 
12345678901234567890123456789- 

70 
12345678901234567890123456789- 
2 -1. 

70 
12345678901234567890123456789- 

70 
12345678901234567890123456789- 

70 
12345678901234567890123456789- 

70 
12345678901234567890123456789- 

70 
12345678901234567890123456789- 
2 



70 



12345678901234567890 



12345678901234567890 
12345678901234567890 



12345678901234567890 



12345678901234567890 
2 1. 



12345678901234567890 
) 
12345678901234567890 



12345678901234567890 



12345678901234567890 



12345678901234567890 
2 -1. 



1234567890123456789- 



CSP28180 
CSP28190 
CSP28200 
CSP28210 
CSP28220 
CSP28230 
CSP28240 
CSP28250 
CSP28260 
CSP28270 
CSP28280 
CSP26290 
CSP28300 
CSP28310 
CSP28320 
CSP28330 
CSP28340 
CSP28350 
CSP28360 
CSP28370 
CSP28380 
CSP28390 
CSP28400 
CSP28410 
CSP28420 
CSP28430 
CSP28440 
CSP28450 
CSP28460 
CSP28470 
CSP28480 
CSP28490 
CSP28500 
CSP28510 
CSP28520 
CSP28530 
CSP28540 
CSP28550 
CSP2S560 
CSP28570 
CSP28580 
CSP28590 
CSP28600 
CSP28610 
CSP28620 
CSP28630 
CSP28640 
CSP28650 
CSP28660 
CSP28670 
CSP28680 
CSP28690 
CSP28700 
CSP28710 
CSP28720 
CSP28730 
CSP28740 
CSP28750 
CSP28760 
CSP28770 
CSP28780 



09 01 
12345678901234567890 

10 01 
12345678901234567890 

11 01 
12345678901234567890 

12 01 
12345678901234567890 

13 1 
-0 

08 01 
1234567890123456789- 

09 01 
1234567890123456789- 

10 01 
1234567890123456789- 

11 01 
1234567890123456789- 

12 01 
1234567890123456789- 



20 


51 


70 


20 


51 


70 


20 


51 


70 


20 


51 


70 


1 


2 


2 


20 


51 


70 


20 


51 


70 


20 


51 


70 


20 


51 


70 


20 


51 


70 



1234567890123456789- 



1234567890123456789- 



1234567890123456789- 



1234567890123456789- 



1234567890123456789- 



1234567890123456789- 



1234567890123456789- 
1234567890123456789- 



1234567890123456789- 



CSP28790 
CSP28800 
CSP28810 
CSP28820 
CSP28830 
CSP28840 
CSP28850 
CSP28860 
CSP28870 
CSP28880 
CSP28890 
CSP28900 
CSP28910 
CSP28920 
CSP28930 
CSP28940 
CSP28950 
CSP28960 
CSP28970 
CSP28980 
CSP28990 
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PROBLEM 2 

The purpose of this program is to create invoices. The input deck is as follows: 







[ ISTOP 










New name 
and balance 
mastercard 






Last cust. 


/ 




. 


/ 


/ 




Transaction '/ 




/ Cust. 4 


/ 




V 






cards 






/ Cust. 3 


/ 




V 














/ 










/ Cust. 2 


/ 


/ 


Name and 

balance 

master card 








/ Cust. 1 


/ 














/ 





















Input deck 



Detailed description of individual customer deck 



Each customer has the old master name and balance card, followed by the transaction 
cards, followed by a blank master name and balance card. The invoice is printed as in 
the example, and a new master name and balance card image is printed on the console 
printer. Then the next customer is processed until the stop code card is reached 
(ISTOP in cc 1-5). In an actual situation the new card image would be punched and 
stacker-selected. Then, as input to the next run of the program, a new input deck 
would have to be prepared. 

Switch settings are the same as for sample problem 1, except that output cannot be 
directed toward the console printer. 



Input 
Device 


Output 
Device 


Switches 





1 


2 


1442 


1132 


., up 

up 


down 
up 


down 
down 


1442 


1403 


2501 


1132 


up 


down 


up 


2501 


1403 


up 


up 


up 



Make sure that the switches are set properly before the program begins. 

After processing is completed, sample problem 2 will STOP with 0111 displayed in the 
accumulator. Press START to continue. 

Note: Sample Problem 2 cannot be executed if Version 1 of the Monitor is being used. 
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Sample Problem 2: Detailed Description 

1. Read all constant information and determine output unit (1132 or 1403), 

2. Initialize error indicators. 

a. J=2 

b. 1=0, L=0, M=0 

3. Read the first card. It should be a master card. 

4. Is the card read in 3 the last card? 
No -5 Yes - 64 

5. Is the card read in 3 above a master card? 
No - 72 Yes - 6 

6. Go to the top of a new page. 

7. Clear the print area. 

8. Print the customer name. 

9. Move the edit mark to the work area. 

10. Edit the previous balance. 

11. Print the customer street address. 

12. Move the words PREVIOUS BALANCE to the print area. 

13. Move the work area to the print area. 

14. Print the customer city, state, and zip code. 

15. Skip 3 lines. 

16. Print the column headings. 

17. Print the print area. 

18. Clear the print area. 

19. Convert the previous balance from Al format to decimal format. 
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20. Is the conversion in 19 correct? 
No - 66 Yes - 21 

21. Set the total (ISUM) equal to the previous balance. 

22. Set up the output area for the new master card. 

23. Read a card. 

24. Is the card read at 23 the last card? 
No - 25 Yes - 64 

25. Is the card read at 23 a master card? 
No - 26 Yes - 52 

26. Is the card read at 23 a transaction card? 
No - 49 Yes - 27 

27. Is the card read at 23 for the same customer being processed? 
No - 49 Yes - 28 

28. Move the item name to the print area. 

29. Move the edit mask to the print area for dollar amount. 

30. Move the edit mask to the print area for quantity. 

31. Edit the quantity. 

32. Edit the dollar amount. 

33. Print the detail line assembled in 28 through 32. 

34. Has channel 12 on the carriage tape been encountered? 
No -35 Yes -46 

35. Convert the dollar amount from Al format to decimal format. 

36. Is the conversion in 35 correct? 
No - 40 Yes - 37 

37. Add the dollar amount to ISUM. 
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38. Did overflow occur in the addition in 37? 
No - 23 Yes - 39 

39. STOP and display 777. 

40. Make the character in error a digit. 

41. Try to convert only the character in error. 

42. Is the conversion in 41 correct? 
No - 43 Yes - 44 

43. STOP and display 666. 

44. Convert the entire field back to Al format. 

45. Go to 35. 

46. Go to the top of a new page. 

47. Print the headings. 

48. Go to 35. 

49. Type ERROR on the console printer. 

50. Type the card read on the console printer. 

51. Go to 23. 

52. Convert the total (ISUM) from decimal format to Al format. 

53. Is the conversion in 52 correct? 
No - 54 Yes - 55 

54. STOP and display 555. 

55. Clear the print area. 

56. Move the edit mask to the print area. 

57. Edit the total (ISUM). 

58. Place the unedited total (ISUM) in the new master card. 

59. Type the new master card image on the console printer. 
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60. Move the word TOTAL to the print area. 

61. Skip 2 lines. 

62. Print the print area, the total line. 

63. Go to 2b. 

64. Type END OF JOB. 

65. STOP and display 111. 

66. Make the character in error a digit. 

67. Try to convert only the character in error, 

68. Is the conversion in 67 correct? 



No — 69 



Yes - 70 



69. STOP and display 444. 

70. Convert the entire field back to Al format. 

71. Go to 19. 

72. Type ERROR on the console printer. 

73. Type the card read on the console printer. 

74. Go to 2b. 

Card Formats 



Customer Name 



99999999999999999999 

1 2 3 4 5 $ 7 I 9 10 It 12 13 14 IS II 17 IB 19 20 



Street Address 



99999999399999999999 

21 22 23 24 25 26 27 28 29 30 jl 32 33 34 35 36 37 38 39 40 



City 



9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 9 

41 42 43 U 45 48 47 48 49 50 51 52 53 54 55 56 57 58 59 60 



99999999 

61 62 63 64 65 66 67 61 



9999999 

I 74 75 F6 77 78 79 80 



Card 
Seq. 
No. 



Customer Name 



Total 
Amt. 



99999999999999999999 

1 2 3 4 5 6 7 I ( 10 11 12 13 14 15 18 17 18 19 » 



99999999999999999999 

212223 24 2526 27 782930 313233343536 37 383940 



99999999 

41 42 43 44 45 46 47 48 49 50 51 



Qty. 



9999 



9999999999999999! 

53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 ( 



c 

s 
p 

999 

73 74 75176 77 78 79 I 



Card 
Seq. 
No. 



9999 
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1130 COMMERCIAL 



SAMPLE PROBLEM 2 



> B3 • 

> • 

• ••• 



• INITIALIZE 



• 02 ». 

• • 
• ••• 



TYPE 
END OF JOB 



X 
HALT 



• • •• 

MASTER CARD '.• 
► • • * 

• • • • 
• • • • 
• YES 



» PRINT NAME 
AND ADDRESS 



PRINT HEADING 
AND PREVIOUS 
» BALANCE « 



*** 






• 


• 


TOTAL 
REPLACED 




• 


• IS 


BY 


• 




PREVIOUS 




• 


• 


BALANCE 




* 



» ». NO 

TRANSACTION .«... 
». CARD .• 



,X«. MASTER CARD 



.* IS •. 

.•TRANSACTION*. NO 

.NAME EQUAL TO 

•. MASTER .• 
•.NAME .• 

**»YES 



PRINT OETAIL 
LINE 



> TOTAL 

►IS REPLACED BY 

> TOTAL £ AMT 



• TYPE NEW 

X MASTER CARD 

• IMAGE 



PKINT 
TOTAL 
LINE 
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Sample Problem 2: Source Program 



// FOR CSP29000 

»» SAMPLE PROBLEM 2 CSP29010 

# NAME SMPL2 CSP29020 

* LIST ALL CSP29030 

* ONE WORD INTEGI *S CSP29040 

• EXTENDED PRECISION CSP29050 

C THE INPUT IS MADE UP OF A MASTER CARD FOLLOWED BY THE TRANSACTION CSP29060 

C CARDS FOR EACH CUSTOMER. WE WANT TO PRINT AN INVOICE AND PRINT A CSP29070 

C NEW MASTER CARD FOR EACH CUSTOMER. CSP29080 

DIMENSION INCRD(82)»I.MASK(13J.IPRNT(79)»IOTCD180>.ISTOP(5). CSP29090 
1IHEAD(80). IPRVB<16).ITOT(5).IWK(13>»ISUM(8).IER0R(6).IEOJ<10) CSP29100 

CALL DATSW (2»N2) CSP29110 

CALL DATSWU.N3) CSP29120 

GO TO (28.27J.N2 CSP29130 

CALL READ< IEOJ*1.10. J) CSP29140 

CALL READUER0R.1.6.J) CSP29150 

CALL READUMASK.1.13.J) CSP29160 

CALL READ(IPRVB.1.16.J) CSP29170 

CALL READ(IHEADtlt72.J) CSP29180 

CALL READ(IHEAD.73.B0.J> CSP29190 

CALL READ(ISTOP.1.5.J> CSP29200 

CALL READUTOT.1.5.J) CSP29210 

GO TO 58 CSP29220 

CALL R2501(IEOJtltlO*J) CSP29230 

CALL R2501(IEROR.1.6»JI CSP29240 

CALL R250KIMASK.1.13.J) CSP29250 

CALL R250KIPRVB.1.16.J) CSP29260 

CALL R2501(IHEAD»lt72tJ> CSP29270 

CALL R2501(IHEAD»"'3.80*J> CSP29280 

CALL R2501(ISTOP.1*5.J> CSP29290 

CALL R250KITOT.1.5.J) CSP29300 

J"2 CSP29310 

INCRD(81)«16448 CSP29320 

INCRD<82)«5440 CSP29330 

1-0 CSP29340 

L-0 CSP29350 

M«0 CSP29360 

GO TO (30.29) *N2 CSP29370 

CALL READUNCRD.1.80.J) CSP29380 

GO TO 59 CSP29390 

CALL R2501(INCRD»1*60*J) CSP29400 

IF(J-l) 22.2t2 CSP29410 

IF(NCOMP(INCRD.1.5»ISTOP»1)) 3»22»3 CSP29420 

CALL NZONE(INCRD.70.5»K> CSP29430 

IF(K-l) 26*4*26 CSP29440 

GO TO (34*33) »N3 CSP29450 

CALL SKIP( 12544) CSP29460 

GO TO 60 CSP29470 

CALL S1403( 12544) CSP29480 

CALL FlLLdPRNT. 1.79. 16448) CSP29490 

GO TO (36*35). N3 CSP29500 

CALL PRINTUNCRD.1.20.I) CSP29510 

GO TO 61 CSP29520 

CALL P1403IINCRD.1.20.I) CSP29530 

CALL MOVE(IMASK»l*13*IWK*l) CSP29540 

CALL EDIT(INCRD»61.68.IWK»1.13) CSP29550 



27 



28 



58 



33 



35 
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SAMPLE PROBLEM 2 



37 



GO TO (38.37) »N3 

CALL PRINTdNCRD.21.40.1) 

GO TO 62 

CALL P1403(INCRD.21.40.I) 

CALL M0VEdPRVB.1.16.IPRNT.23> 

CALL M0VE(IWK.1.13»IPRNT»67) 

GO TO (41.39J.N3 

CALL PRINT(INCRD.4l.60.I) 

CALL SKIP(16128> 

CALL PRINTdHEAD. 1.80*1) 

CALL PRINT(IPRNTtl.79.II 

GO TO 63 

CALL P1403dNCRD.41i60.il 

CALL 51403U6128) 

CALL P1403UHEAD.1.80.I) 

CALL P1403UPRNT.1.79.I) 

CALL FILL! IPRNT. 1.79*16448) 

CALL A1DECUNCRD.61.68.L) 

IF(L) 5.5*23 

CALL MOVE( INCRD.61.68.ISUM.il 

CALL MOVE(INCRD.l.SO.IOTCD.l) 

GO TO (32.3D.N2 

CALL READ(INCRD.1.80»J) 

GO TO 64 

CALL R2501(INCRD*1*80*JI 

IF(J-l) 22.7.7 

CALL NZONE(INCRD.70.5*K) 

IF(K-l) 18*19*8 

IFU-21 18*9.18 

IF(NCOMP( INCRD.1.20.IOTCD.1) I 18 

CALL M0VE(INCRD.21.40.IPRNT.23> 

CALL MOVE! IMASK.1.13.IPRNT. 671 

CALL MOVEIIMASK.3.8.IPRNT.7) 

IPRNT( 121—4032 

CALL EDIT(INCRD.49»52.IPRNT.7.12I 

CALL EDIT(INCRD.41.48.IPRNT.67.79) 

GO TO(49»48J.N3 

CALL PRINTUPRNT.1.79.IJ 

GO TO 65 

CALL P1403UPRNT. 1.79.1) 

IF(I-3) 11*11.17 

CALL AlDECdNCRD. 41.48. L) 

IFILI 12.12.14 

CALL ADD( INCRD.41.48»ISUM*l'*8.M) 

IF(M) 13.6.13 

CALL IOND 

STOP 777 

CALL NZ0NEIINCRD.L.4.N1) 

Nl-0 

CALL AlDECdNCRD. L.L.N1) 

IF(N1) 16.16.15 

CALL IOND 

STOP 666 

CALL DECAKINCRD.41.48.LI 



PAGE 02 

CSP29560 
CSP29570 
CSP29580 
CSP29590 
CSP29600 
CSP29610 
CSP29620 
CSP29630 
CSP29640 
CSP29650 
CSP29660 
CSP29670 
CSP29680 
CSP29690 
CSP29700 
CSP29710 
CSP29720 
CSP29730 
CSP29740 
CSP29750 
CSP29760 
CSP29770 
CSP29780 
CSP29790 
CSP29800 
CSP29810 
CSP29820 
CSP29830 
CSP29840 
CSP29850 
CSP29860 
CSP29870 
CSP29880 
CSP29890 
CSP29900 
CSP29910 
CSP29920 
CSP29930 
CSP29940 
CSP29950 
CSP29960 
CSP29970 
CSP29980 
CSP29990 
CSP30000 
CSP30010 
CSP30020 
CSP30030 
CSP30040 
CSP30050 
CSP30060 
CSP30070 
CSP30080 
CSP3O090 



SAMPLE PROBLEM 2 



19 



21 



L-0 

GO TO 11 

GO TO (51.50) *N3 

CALL SKIP< 125441 

CALL PRINTUHEAD. 1.80.1) 

GO TO 66 

CALL S1403( 12544) 

CALL P1403UHEAD.1.80.IJ 

1-0 

GO TO 11 

CALL TYPERdEROR.1.5) 

CALL TYPERUNCRD.1.82) 

GO TO 6 

CALL DECAKISUM.1.8.L) 

IF(L) 20.21.20 

CALL IOND 

STOP 555 

CALL FILL! IPRNT. 1.79. 16448) 

CALL MOVECIMASK.1.13.IPRNT.67) 

CALL EDIT(ISUM.1.8.IPRNT.67.79) 

CALL M0VEUSUM.1.8.I0TCD.61J 

CALL TYPER(IOTCD.1.80) 

CALL MOVE( ITOT.1.5*IPRNT*23) 

GO TO (55.54) »N3 

CALL SKIP115872) 

CALL PRINTdPRNT.l*79.I> 

GO TO 67 

CALL S14031 15872) 

CALL P1403(IPRNT.1.79.I) 

CALL TYPERdNCRD. 81*82) 

GO TO 1 

CALL TYPER(IEOJ.l.lO) 

CALL IOND 

STOP 111 

CALL NZ0NE(INCRD.L.4.N1) 

N1>0 

CALL AlDECdNCRD. L.L.N1) 

IF(N1) 25.25.24 

CALL IOND 

STOP 444 

CALL DECAKINCRD.61.68.L) 

L-0 

60 TO 40 

CALL TYPER(IEROR.l»5) 

CALL TYPER(INCRD.1.82) 

GO TO 1 

END 



VARIABLE ALLOCATIONS 
INCRD-0051 IMASK-005E IPRNT«00AD IOTCD-00FD 
IEROR«0182 IEOJ -018C N2 -018D N3 »018E 
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CSP30100 
CSP30110 
CSP30120 
CSP30130 
CSP30140 
CSP30150 
CSP30160 
CSP30170 
CSP30180 
CSP30190 
CSP30200 
CSP30210 
CSP30220 
CSP30230 
CSP30240 
CSP30250 
CSP30260 
CSP30270 
CSP30280 
CSP30290 
CSP30300 
CSP30310 
CSP30320 
CSP30330 
CSP30340 
CSP3035O 
CSP30360 
CSP30370 
CSP30380 
CSP30390 
CSP30400 
CSP30410 
CSP30420 
CSP30430 
CSP30440 
CSP30450 
CSP30460 
CSP30470 
CSP30480 
CSP30490 
CSP30500 
CSP30510 
CSP30520 
CSP30530 
CSP30540 
CSP30550 
CSP30560 



ISTOP-0102 IHEAD>0152 IPRVB«0162 ITOT -0167 IWK -0174 ISUM -017C 
J *018F I *0190 L «0191 M >0192 K -0193 Nl -0194 



ST*JEMENT ALLOCATIONS 
27 -0106 28 -0208 



58 -0238 1 



•0248 29 -025A 30 -0262 59 -0268 2 



•026E 3 
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SAMPLE PROBLEM ? 




















PAGE 


04 














33 -0269 34 


■028E 


60 


■0291 


35 


■0290 


36 


■02A5 


61 


-02AB 


37 


■02C0 


38 


-02C8 


62 


■02CE 


39 


■ 02E2 


41 -02F9 63 


-030E 


40 


■0314 


5 


■031E 


6 


■ 032C 


31 


■0332 


32 


-033A 


64 


■ 0340 


7 


-0346 


8 


■ 0354 


9 «035A 10 


■0363 


48 


■0395 


49 


■ 039D 


65 


■ 03A3 


11 


■ 03A9 


12 


-03B3 


13 


-03C0 


14 


-03C4 


15 


■ 03D8 


16 -03DC 17 


■03E8 


50 


■03EE 


51 


■03F9 


66 


-0402 


18 


■ 0408 


19 


-0414 


20 


• 041E 


21 


■ 0422 


54 


-045U 


55 -045B 67 


■0464 


22 


■046B 


23 


■0474 


24 


-0488 


25 


■ 048C 


26 


-0498 















FEATURES SUPPORTED 
ONE WORD INTEGERS 
EXTENDED PRECISION 



CALLED SUBPROGRAMS 
DATSW READ R2501 
DECA1 TYPER STOP 



NCOMP NZONE 



S1403 FILL PRINT P1403 



INTEGER CONSTANTS 

2-0198 1-0199 



16448-01A2 
40-01AC 
49-01B6 
81-01C0 



5440-01A3 

23>01A0 

52«01B7 

111«01C1 



10«019A 

0-01A4 

67-01AE 

12>01B6 

444-01C2 



6-019B 

70-01A5 

41-01AF 

48-01B9 

1911-01C3 



13-019C 

12544-01A6 

60-01B0 

777-01BA 

1638-01C4 



16-019D 

79«01A7 

16128-01B1 

4-01BB 

1365-01C5 



72-019E 

20-01A8 

3-01B2 

666-01BC 

273-01C6 



73-019F 

61-01A9 

8-01B3 

82-01BD 

1092-01C7 



80-01A0 5-01A1 

68-01AA 21-01AB 

7-01B4 4032-01B5 

555-01BE 15872-01BF 



CORE REQUIREMENTS FOR SMPL2 
COMMON VARIABLES 



408 PROGRAM 



780 



END OF COMPILATION 
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Sample Problem 2: Invoice Output 



OAVES MARKET 

1997 WASHINGTON ST. 

NEWTOWN* MASS. 02158 



OTY 

8 

11 

10 

8 

6 

17 

17 

17 

17 

17 

17 

25 

25 

10 

10 

12 

12 

12 

12 

12 

12 

1.000 

4.000 

200 

100 

50 

100 

100 

100 

10 

12 

12 

12 

12 

12 

12 

1.000 

4.000 

200 

50 

100 

100 

100 

100 

10 

12 

1.000 



NAME 

PREVIOUS BALANCE 

SUGAR - BAGS 

CHICKEN SOUP - CASES 

TOMATO SOUP - CASES 

SUGAR RETURNED 

COOKIES - CASES 

GINGER ALE * CASES 

ROOT BEER - CASES 

ORANGE ADE - CASES 

CREME SODA - CASES 

CHERRY SODA - CASES 

SODA WATER - CASES 

DOG FOOD - CASES 

CAT FOOD - CASES 

SOAP POWDER - CASES 

DETERGENT - CASES 

HAM - TINS 

HAM - LOAF 

SALAMI 

BOLOGNA 

CORNED BEEF 

ROAST BEEF 

BREAD - LOAF 

ROLLS 

MILK - QUARTS 

MILK - HALF GALS 

MILK - GALS 

POTATOES - BAGS 

TOMATOES - LOOSE 

CARROTS - BUNCHES 

DETERGENT - CASES 

HAM - TINS 

HAM - LOAF 

SALAMI 

BOLOGNA 

CORNED BEEF 

ROAST BEEF 

BREAD - LOAF 

ROLLS 

MILK - QUARTS 

MILK - GALS 

MILK - HALF GALS 

POTATOES - BAGS 

TOMATOES - LOOSE 

CARROTS - BUNCHES 

DETERGENT - CASES 

HAM - TINS 

BREAD - LOAF 



AMT 
$111.29 
$21.02 
$38.76 
$30.11 
$21.02CR 
$45.21 
$52.37 
$52.37 
$52.37 
$52.37 
$52.37 
$52.37 
$101.26 
$101.26 
$72.89 
$72.89 
$36.75 
$33.75 
$33.75 
$33.75 
$33.75 
$33.75 
$150.00 
$150.00 
$57.42 
$57.42 
$57.42 
$11.23 
$11.23 
$11.23 
$72.89 
$36.75 
$33.75 
$33.75 
$33.75 
$33.75 
$33.75 
$150.00 
$150.00 
$57.42 
$57.42 
$57.42 
$11.23 
$11.23 
$11.23 
$72.89 
$36.75 
$150.00 



QTY 


NAME 


4.000 


ROLLS 


200 


MILK - QUARTS 


100 


MILK - HALF GALS 


50 


MILK - GALS 


100 


POTATOES - BAGS 


100 


TOMATOES - LOOSE 


100 


CARROTS - BUNCHES 


10 


DETERGENT - CASES 


12 


HAM - TINS 


12 


HAM - LOAF 


12 


SALAMI 


12 


BOLOGNA 


12 


CORNED BEEF 


12 


ROAST BEEF 


1.000 


BREAD - LOAF 


4.000 


ROLLS 


200 


MILK - QUARTS 


100 


MILK - HALF GALS 


100 


MILK - HALF GALS 


100 


POTATOES - BAGS 


100 


TOMATOES - LOOSE 


100 


CARROTS - BUNCHES 


10 


DETERGENT - CASES 


12 


HAM - TINS 



AMT 
$150.00 
$57.42 
$57.42 
$57.42 
$11.23 
$11.23 
$11.23 
$72.89 
$36.75 
$33.75 
$33.75 
$33.75 
$33.75 
$33.75 
$150.00 
$150.00 
$57.42 
$57.42 
$57.42 
$11.23 
$11.23 
$11.23 
$72.89 
$36.75 



STAND I SH MOTORS 
10 WATER STREET 
PLYMOUTH. MASS. 02296 



QTY 

20 
6 
20 
50 
50 
100 



NAME 

PREVIOUS BALANCE 
AIR CLEANERS - CASES 
GREASE > BARRELS 
TIRES - 650 X 13 
TIRES - 750 X 14 
TIRES - 800 X 14 
GASOLINE CAPS 



AMT 

$2,356.36 

$200.03 

$165.24 

$260.38 

$900.53 

$1*012.00 

$99.68 
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Sample Problem 2: Console Printer Log and New Master Card Listing 



ERROR THIS IS A DELIBERATE ERROR j CS P30660 

ERROR DAVE MARKET THIS CARD IS A DELIBERATE MISTAKE J CSP30680 

DAVES MARKET 1997 WASHINGTON ST. NEWTOWN, MASS. 0215800389325 A CSP3067O 
ERROR STANDISH MOTOR THIS CARD IS NOT CORRECT ABCDEFGHIJKLMNOPQRSTUVJ CSP31470 
STANDISH MOTORS 10 WATER STREET PLYMOUTH, MASS. 0229600U99U 22 A CSP31410 
END OF JOB 
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Sample Problem 2: Data Input Listing 



// XEQ 
END OF JOB 
ERROR 

• S. CR 

PREVIOUS BALANCE 

QTY NAME 

AMT 
ISTOP 
TOTAL 
THIS IS A DELIBERATE ERROR 



DAVES MARKET 
DAVE MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
D.AVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 
DAVES MARKET 



1997 WASHINGTON ST. NEWTOWNt MASS. 021580001] 

THIS CARD IS A DELIBERATE MISTAKE 
SUGAR - BAGS 000021020008 
CHICKEN SOUP - CASES000038760011 
TOMATO SOUP - CASES 000030110010 
SUGAR RETURNED 0000210K0008 
COOKIES - CASES 000045210006 
GINGER ALE - CASES 000052370017 
ROOT BEER - CASES 000052370017 
ORANGE ADE - CASES 000052370017 
CREME SODA - CASES 000052370017 
CHERRY SODA - CASES 000052370017 
SODA WATER - CASES 000052370017 
DOG FOOD - CASES 000101260025 
CAT FOOD - CASES 000101260025 
SOAP POWDER - CASES 000072890010 
DETERGENT - CASES 000072890010 
HAM - TINS 



HAM - LOAF 

SALAMI 

BOLOGNA 

CORNED BEEF 

ROAST BEEF 

BREAD - LOAF 

ROLLS 

MILK - QUARTS 

MILK - HALF GALS 

MILK - GALS 

POTATOES - BAGS 

TOMATOES - LOOSE 

CARROTS - BUNCHES 

DETERGENT - CASES 

HAM - TINS 

HAM - LOAF 

SALAMI 

BOLOGNA 

CORNED BEEF 

ROAST BEEF 

BREAD - LOAF 

ROLLS 

MILK - QUARTS 

MILK - GALS 

MILK - HALF GALS 

POTATOES - BAGS 

TOMATOES - LOOSE 

CARROTS - BUNCHES 

DETERGENT - CASES 

HAM - TINS 

BRE'VD - LOAF 

ROLLS 



000036750012 
000033750012 
000033750012 
000033750012 
000033750012 
000033750012 
000150001000 
000150004000 
000057420200 
000057420100 
000057420050 
000011230100 
000011230100 
000011230100 
000072890010 
000036750012 
000033750012 
000033750012 
000033750012 
000033750012 
000033750012 
000150001000 
000150004000 
000057420200 
000057420050 
000057420100 
000011230100 
000011230100 
000011230100 
000072890010 
000036750012 
000150001000 
000150004000 



CSP30570 
CSP30580 
CSP30590 
CSP30600 
CSP30610 
CSP30620 
CSP30630 
CSP30640 
CSP30650 
CSP30660 
CSP30670 
CSP30680 
CSP30690 
CSP30700 
CSP30710 
CSP30720 
CSP30730 
CSP30740 
CSP3075O 
CSP30760 
CSP3077O 
CSP30780 
CSP30790 
CSP30800 
CSP30810 
CSP30820 
CSP30830 
CSP30840 
CSP3085O 
CSP30860 
CSP30870 
CSP30880 
CSP30890 
CSP30900 
CSP30910 
CSP30920 
CSP30930 
CSP30940 
CSP30950 
CSP30960 
CSP30970 
CSP30980 
CSP30990 
CSP31000 
CSP31010 
CSP31020 
CSP31030 
CSP31040 
CSP31050 
CSP31060 
CSP31070 
CSP31080 
CSP31090 
CSP31100 
CSP31110 
CSP31120 
CSP31130 
CSP31140 
CSP31150 
CSP31160 



DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 
DAVES 



MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 
MARKET 



STANDISH 
STANDISH 
STANDISH 
STANDISH 
STANDISH 
STANDISH 
STANDISH 
STANDISH 

ISTOP 



MOTORS 

MOTORS 

MOTORS 

MOTORS 

MOTORS 

MOTORS 

MOTOR 

MOTORS 



MILK - QUARTS 
MILK - HALF GALS 
MILK - GALS 
POTATOES - BAGS 
TOMATOES - LOOSE 
CARROTS - BUNCHES 
DETERGENT - CASES 
HAM - TINS 
HAM - LOAF 
SALAMI 
BOLOGNA 
CORNED BEEF 
ROAST BEEF 
BREAD - LOAF 
ROLLS 

MILK - QUARTS 
MILK - HALF GALS 
MILK - HALF GALS 
POTATOES - BAGS 
TOMATOES - LOOSE 
CARROTS - BUNCHES 
DETERGENT - CASES 
HAM - TINS 



000057420200 
000057420100 
000057420050 
000011230100 
000011230100 
000011230100 
000072890010 
000036750012 
000033750012 
000033750012 
000033750012 
000033750012 
000033750012 
000150001000 
000150004000 
000057420200 
000057420100 
000057420100 
000011230100 
000011230100 
000011230100 
000072890010 
000036750012 



10 WATER STREET PLYMOUTHt MASS. 0229600235636 A 
AIR CLEANERS - CASES000200030020 J 

GREASE - BARRELS 000165240006 J 

TIRES - 650 X 13 000260380020 J 

TIRES - 750 X 14 000900530050 J 

TIRES - 800 X 14 001012000050 J 

THIS CARD IS NOT CORRECT ABCDEFGHI JKLMNOPQRSTUVJ 
GASOLINE CAPS 000099680100 J 

A 



CSP31170 
CSP31180 
CSP31190 
CSP31200 
CSP31210 
CSP31220 
CSP31230 
CSP31240 
CSP31250 
CSP31260 
CSP31270 
CSP31280 
CSP31290 
CSP31300 
CSP31310 
CSP31320 
CSP31330 
CSP31340 
CSP31350 
CSP31360 
CSP31370 
CSP31380 
CSP31390 
CSP31400 
CSP31410 
CSP31420 
CSP31430 
CSP31440 
CSP31450 
CSP31460 
CSP31470 
CSP31480 
CSP31490 
CSP31500 
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PROBLEM 3 



The purpose of this program is to print a payroll register and punch a new year-to-date 
card for each employee. The input deck is as follows: 









Last 
employee 


/ 


/ 










/ 


) 
















/ 




/ 


Blank 






/ 

Blank 


/ Employee 






/ 


/ 














/ 3 






/ 


/ 


Current 
card 






/ 




/ Employee 


/ 


/ 


V 








card 






/ ^ 




V 


Year-to-date 
card 


/ 






/ Employee 
/ 1 




/ 




Current 
card 






/ 


r 



























Input deck 



Employee deck 



The year-to-date and current cards are read and processed. The payroll register is 
printed as in the example, and a new year-to-date card image is printed on the console 
printer. Then the next employee is processed. 

As is shown, the order of the year-to-date card and current card is not known before 
the cards are read. 



Switch settings 


are as follows: 








Input 
Device 


Output 
Device 


Switches 





1 


2 


1442 


console printer 


down 


down 


down 


1442 


1132 


up 


down 


down_-~ 


1442H~ 


1403 


up 


up 


down 


2501 


console printer 


down 


down 


up 


2501 


1132 


up 


down 


up 


2501 


1403 


up 


up 


up 



Make sure that the switches are set properly before the program begins. 

After processing is completed, sample problem 3 will STOP with 3333 displayed in the 
accumulator. Press START to continue. 

A general purpose *IOCS card has been supplied with the sample problem. If this does 
not match the 1130 configuration to be used, a new *IOCS card will be required. 

*IOCS (CARD, 1132 PRINTER, TYPEWRITER) 
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Sample Problem 3: Detailed Description 

1. Determine the output unit from the data switches. 
Console printer, 1132 Printer, or 1403 Printer 

2. Read the edit mask. 

3. Read a card. 

4. Is the card read in (3) blank? 
Yes - 18 No — 5 

5. Is the card read in (3) a year-to-date card? 

Yes - 11 No - 6 

6. Is the card read in (3-) a current card? 
Yes - 8 No - 7 

7. Stop. 

8. Move the employee number to storage (JEMP). 

9. Extract the number of hours worked (HRS). 

10. Go to (3). 

11. Move the department number to storage (IDEP). 

12. Move the employee number to storage (IEMP). 

13. Move the employee name to storage (INM). 

14. Move the Social Security number to storage (ISS). 

15. Move the pay rate to storage (IRT). 

16. Move the year-to-date gross to storage (IYTD). 

17. Goto (3). 

18. Are IEMP and JEMP the same? 
Yes - 19 No - 24 

19. Current amount (CURR) is set equal to HRS times pay rate, 
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20. New yeax-to-date is set equal to CUHR +IYTD. 

21. Print a new year-to-date card image on the console printer, 

22. Print the payroll register line as in the example. 

23. Go to (3). 

24. Halt. If start is pushed, go to (3). 

Card Formats 



p. 

No. 

999 

4 5 6 



Employee Name 



99999999999999999999 

7 1 9 10 11 12 1] 14 IS IS 17 II II » 21 22 23 24 25 » 



Social 

Security 

No. 

999999999 

29X313233343536 37 



Pay 
Rate 



9999 

3139 40 41 



YTD 

Gross 

9999999 

42 43 44 45 46 47 41 



999999999999999999999 

49 SO 51 52 53 54 55 56 57 51 59 60 SI 52 S3 64 (5 66 87 68 S9 



99999999 



Card 
Seq. 
No. 



999 

1 2 3 



Employee Name 



99999999999999999999 

4 S $ 7 I I 10 11 12 13 14 IS IS 17 IS IS 20 21 22 23 



9999 

29 30 31 



99999999999999999999999999999999999999 

32 33 34 35 36 37 31 39 4041 42 43 44 45 46 47 41 49 SO 51 52 53 54 55 56 57 SS 59 60 61 62 63 64 65 66 67 SS 69 



c 
s 
p 

999 



Card 
Seq. 
No. 



9 

70 71 72 '3 74 75|76 77 7S 79 I 



99999 



New 
Y 
T 
D 



99999999999999999999999999999999999999 9 9999 9999999999999 9999999999999 

1 2 3 4 5 S 7 S I 10 11 12 13 14 15 16 17 IS II 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 31 39 40 41 42 43 44 45 46 47 41 49 SO 51 52 S3 54 55 56 57 SS 59 60 61 62 63 64 65 66 67 61 69 



c 
s 

p 

999 

73 74 75 



Card 
Seq. 
No. 



99999 

76 77 78 79 80 



when New YTD 
Code = 1 when year-to-date 
2 when current 

9999999999999999999999999999999999999999999999999999999999999999999999999999999 9 

1 2 3 4 5 S 7 I I 10 11 12 13 14 15 IS 17 IS IS 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 4041 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 SO 
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CHART S3 



1130 COMMERCIAL 



SAMPLE PROBLEM 3 



DETERMINE 

OUTPUT 

UNIT 



• REAO E01T • 
MASK 



• NZERO 
•IS REPLACED BY 

• NZERO L 1 



■ IS NZERO 
EQUAL TO 
•• 1 



YES 



IS IEMP 
EQUAL TO 
. JEMP 



• 03 • . 

• • .X. 

• ••• 

X 



YES .• IS CODE 
...*. EQUAL TO 
». 



TYPE 
THE EMP. NOS. 
00 NOT MATCH 



> 03 * 

> 4 
• ••• 



• CURR 

•IS REPLACED BY 

• HRS • IRT 



YTD 

•IS REPLACEO BY 

CURR £ I YTD 



TYPE A NEW YTD 
■ CARD IMAGE 



► NZERO 

►IS REPLACED BY 

► 



IS CODE 

EQUAL TO 

1 



• IS CODE 
EQUAL TO 
». 2 



PRINT 
DETAIL LINE 



• IDfcP 

•IS REPLACED BY 

• DEPARTMENT 

• NUMBER 



IEMP • 
IS RfcPLACED BY • 
EMPLOYEE NUKBE1.* 



INM 
IS REPLACED bY 
EMPLOYEE NOME 



JEMP 
IS REPLACED BY 
EMPLOYEE NUMBER 



• HRS 

•IS REPLACED BY 

• HOURS WORKED 



■ ISS « 

US REPLACED BY « 
►SOCIAL SECURITY* 

► NUMBER « 



• IRT 

•IS REPLACED BY 

• PAY RATE 



IYTD 

IS REPLACED BY 

YEAR-TO-DATE 

GROSS 



• ••• 
' 03 1 
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Sample Problem 3: Source Program 



// JOB CSP31510 

" FOR CSP31520 

* NAME SP3 . CSP31530 
*I0CS(CARD.U32 PRINTER. TYPEWRITER) CSP31540 

• ONE WORD INTEGERS CSP31550 

* EXTENDED PRECISION CSP31560 

# LIST ALL CSP31570 

DIMENSION MASK(12>.IN(69>.IDEP(2>»IEMP(3)»INM(20).ISS(9).IRT(4). CSP31580 
1 IYTD(7>.JEMP(3),NYTD<7).ICUR(6).KCURR(12>»KOYTD(12).KNYTD(12) CSP31590 

1 FORMAT (69A1.U) CSP31600 

2 FORMAT (12A1) CSP31610 
20 FORMAT ( 1H .2A1 .1X.23A1.2X.20A1.21X.1H1 .3X.7HCSP ) CSP31620 
30 FORMAT (1H .2A1 »2X .3A1 .2X.20A1 .5X.3 ( 12A1 .2X J ) CSP31630 

CALL DATSW(O.I) CSP31640 

CALL DATSW(l.M) CSP31650 

CALL DATSW(2.L) CSP31660 

NREAD-6*(l/L)+2 CSP31670 

NWRIT-2»(1/I)+2*(1/M)+1 CSP31680 

READ (NREAD.2) MASK CSP31690 

15 READ (NREAD.l) IN.ICD CSP31700 

IF (ICD) 6.10*6 CSP31710 

6 NZERO-0 CSP31720 

GO TO (7.8i. ICD CSP31730 

C THIS IS THE YEAR TO DATE PROCESSING CSP31740 

7 CALL MOVE ( IN.l .2. IDEP. 1 J CSP31750 
CALL MOVE ( IN. 4. 6. IEMP. 1) CSP31760 
CALL MOVE (IN.7.26.INM.1) CSP31770 
CALL MOVE (IN.29.37.ISS.1) CSP31780 
CALL MOVE (IN. 38.41. IRT.l) CSP31790 
CALL MOVE (IN.42.48.IYTD.1) CSP31B00 
GO TO 15 CSP31810 

C THIS IS CURRENT PERIOD PROCESSING CSP31820 

8 CALL MOVE ( IN.l ,3. JEMP.l ) CSP31830 
HRS-GET (IN. 28. 30. 100. 01 CSP31840 
GO TO 15 CSP31850 
NZERO ■ NZERO + 1 CSP31860 
IF (NZERO - U 100.100.101 CSP31870 
STOP 3333 CSP31880 
IF (NCOMP< IEMP. 1.3. JEMP.l)) 99.11.99 CSP31890 

11 CURR«(HRS»GET(IRT.1.4.10.0)+500.0)/1000.0 CSP31900 

YTD-CURR+GET ( I YTD. 1 .7.10.0) CSP31910 

CALL PUT (NYTD. 1.7. YTD. 5. 0.1) CSP31920 

WRITE (1.20) IDEP.IEMP.INM.ISS.IRT.NYTD CSP31930 

CALL PUT (ICUR.1.6.CURR.5.0.1) CSP31940 

CALL MOVE (MASK.1.12.KCURR.1) CSP31950 

CALL MOVE (MASK. 1.12. KOYTD.l) CSP31960 

CALL MOVE (MASK. 1.12. KNYTD.l) CSP31970 

CALL EDIT (ICUR.1.6.KCURR.1.12) CSP31980 

CALL EDIT (IYTD.1.7.KOYTD.1.12) CSP31990 

CALL EDIT (NYTD.1.7.KNYTD.1.12) CSP32000 

WRITE (NWRIT.30) IDEP. IEMP. INM.KOYTD.KCURR.KNYTD CSP32010 

GO TO 15 CSP32020 

C THIS IS AN ERROR. THE EMP NOS DO NOT MATCH. CSP32030 

99 WRITE (1.40) CSP32040 

40 FORMAT (• THE EMP NOS DO NOT MATCH.') CSP32050 

GO TO 15 CSP32060 



10 



101 
100 



SAMPLE PROBLEM 3 
END 

VARIABLE ALLOCATIONS 
HRS -0000 CURR -0003 
IYTD -0089 JEMP -008C 
NREAD-00C1 NWRIT-00C2 

STATEMENT ALLOCATIONS 
1 -00E8 2 -00EC 
101 >01CB 100 -01CD 











PAGE 02 






















CSP32070 














YTD -0006 
NYTD -0093 
ICD «00C3 


MASK -0017 
ICUR -0099 
NZERO-00C4 


IN -005C 
KCURR-00A5 


IDEP -005E 
K0YTD«00B1 


IEMP -0061 
KNYTD-OOBD 


INM 

I 


-0075 
-OOBE 


ISS 
M 


-007E 
-OOBF 


IRT 

L 


-0082 
-00C0 


20 >00EF 
11 -01D6 


30 -0103 
99 -0259 


40 -0114 


15 -016C 


6 -0178 


7 


-0182 


8 


■01AE 


10 


-01BF 



FEATURES SUPPORTED 
ONE WORD INTEGERS 
EXTENDED PRECISION 
IOCS 



CALLED SUBPROGRAMS 
DATSW MOVE GET 
SFIO SIOAI SIOI 



NCOMP 
STOP 



PUT 
CARDZ 



EDIT 
P^RNTZ 



EADD 



EMPY 



EDIV 



REAL CONSTANTS 

•100000000E 03-00C6 

INTEGER CONSTANTS 

0-00D5 1-00D6 
41-00DF 42-00E0 

CORE REQUIREMENTS FOR SP3 
COMMON VARIABLES 



•100000000E 02-00C9 



2-00D7 
48-00E1 



6-00D8 
3-00E2 



•500000000E O3-O0CC 



4-00D9 
28-OOE3 



198 PROGRAM 



.100000000E 04-00CF 



7-00DA 
30-00E4 



26-00DB 
3333-00E5 



29-00DC 
12-00E6 



500000000E 01-00D2 



37-00DD 
13107-00E7 



END OF COMPILATION 
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Sample Problem 3: Payroll Register Output 



01 


101 


NALNIUQ . J 


$7*453.06 


$198.91 


$7*651.97 


52 


201 


0MIN0REG* M 


$3,524.37 


$143.82 


$3*668.19 


76 


676 


NEDAB* R 


$10*060.60 


$297.27 


$10*357.87 


76 


689 


NEDUOL. R 


$10*060*60 


S297.27 


' $10,357.87 


01 


253 


NROH » J 


S9»555.62 


S279.65 


$9*835.27 
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Sample Problem 3: Console Printer Error Log and New Year-to-Date Card Image 



01 101NALNIUQ, J 798566432051*20765197 



52 2010MINOREG, M 01332567801*230366819 1 CSP 



76 676NEDAB, R. 011*23306008101035787 



76 689NEDU0L, R 79860379408101035787 



THE EMP NOS DO NOT MATCH. 



01 253NROH, J 95462305707620983527 1 CSP 
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Sample Problem 3: Data Input Listing 



// XEQ 

t S. CR 

01 101NALNIUQ » J 
101NALNIUQ , J 

201OMINOREGt M 
52 2010MIN0REG* 

76 676NEDAB. R 
676NEDABt R 

689NE0U0L. R 
76 6B9NEDUOL* R 

99 9990NATNOM J 
099ONATNOM . J 

01 253NROH . J 
2S3NROH * J 



79856643205420745306 
01367 



52340 

01332567804230352437 



01423306008101006060 
76367 



76367 

79860379408101006060 



99999999901160511122 
994009 



95462305707620955562 
01367 



CSP32080 
CSP32090 
CSP32100 
CSP32110 
CSP32120 
CSP32130 
CSP32140 
CSP32150 
CSP32160 
CSP32170 
CSP32180 
CSP32190 
CSP32200 
CSP32210 
CSP32220 
CSP32230 
CSP32240 
CSP32250 
CSP32260 
CSP32270 
CSP32280 
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FLOWCHARTS 



fADDl 
A1A3 
A1DEC 
A3A1 
CARRY 
DECA1 
DIV 

DPACK 
DUNPK 
EDIT 
FILL 
GET 
ICOMP 
IOND 
KEYBD 
MOVE 
MPY 
NCOMP 
NSIGN 
NZONE 
PACK 
PRINT 
PUNCH 
PUT 
P1403 
P1442 
READ 
R2501 
SKIP 
STACK 
SUB 
S1403 
TYPER 
UNPAC 
WHOLE 



1130 COMMERCIAL 



ADD/SUB SUBROUTINE 



t * 

> START SUB < 

t * 

*************** 



*****gl* ********* 

* SET UP AN * 
♦INSTRUCTION TO * 

* CHANGfc JCARD *. 

* SIGN * 

* * 

***************** 



**** A 2********* 
> * 

* START ADD * 
i i 

*************** 



X 

*****B2**** ****** 
♦CLEAR AND SAVE * 
♦SIGNS ON JCARD * 

* AND KCARO * 

* FIELDS * 

* * 
***************** 



*****C 2 ********** 

* CALCULATE THE * 
*OPERATION-LSIGN* 
*IS REPLACED BY * 

* JSIGN * KSIGN * 

* * 
***************** 



*****D 2 ********** 

* KNOW t S * 

* REPLACED BY * 
♦KLAST - JLAST £* 

* J * 



***< 
* 
* C5 

***x 



************* 



.*. 
E2 *. 



c*** 



c****p 2** ** ****** 



t ********** ****** 



*****H1 ********** 

* JNOW IS * 

* RtPLACED i3Y * 

* JNOW £ 1 * 



*****g 2* ********* 
*KCARDJKNCW> IS * 

* REPLACED BY * 

* LSIGN * * 

* JCARDIJNOW) £ * 

* KCAKD(KNOW) * 
***************** 



<****H2** ******** 
< * 

* KNCW I S * 
> REPLACED BY * 

* KNOW £ 1 * 
t * 
% ********** ****** 



J2 * . 
.*IS JNJW*. 
NU .* GREATER 
...*. THAN 

*. JLAST 
*. .* 



* YES 



***=} 
* 
* A4 

***=! 



A4 *. 

.* *. 

LCW .* KNOW IS *. HI 

,...*. COMPARED TO .*... 

*. ZERO .* 

*. .* 

*. .* 

* EQL 



*****g 7* ********* 
*KCARD<KLAST> IS* 

* REPLACED BY * 
*KCARD<KLAST) £ * 

* KNOW * 

* * 
**** ************* 



*****C3***x 



**** *****»*****< 



*****B4********** 

* * 

* RESTORE SIGNS * 

* ON JCARD AND * 

* KCARD FIELLS * 

* * 
***************** 



****C^********* 
* EXIT i 

*************** 



KCAR3 .Ki 
KLAST, 9 



*******«*> 



C5 *.X 
i*** 



c****C5 ********** 



i ************ 



**** *c3********** 

* * 
*KCARD(KNCW) IS * 
♦REPLACED 3Y 9 -* 

* KCAPD(KNOW) * 

* * 
***************** 



E3 *. 
.* *. 
.* IS KNOW 
>. LESS THAN 
*. KLAST . 



*****E<^ ********** 

* * 

* KNOW IS * 
<* REPLACED BY * 

* KNOW £ 1 * 

* * 
***************** 



**** *F3** ******** 

* * 

* KSIGN TS * 

* REPLACED BY * 

* -KSIGN * 

* * 
***************** 



* KCARD, K, * 

* KLAST, KNOW * 

* * 
***************** 

X 
**** 

* * 

* AA * 

* * 
**** 
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A10EC SUBROUTINE 



••-•—•-• 



• JCARD,JLAST, 

• 4tJSIGN 



• JNOH • 
•IS REPLACED BY • 

• J • 



• JTEST 
•IS REPLACED BY 

• JCARDSJNOWn 



NO 



IS JTEST 
LESS THAN 
. -4032 . 



YES .YES 



IS JTEST •. NO 
LESS THAN .«... 
. ZERO .• 



IS JTEST 

AN EBCDIC 
, BLANK . 



• NER 

♦IS REPLACED BY 

• JNOW 



JTEST I 
IS REPLACED BY « 
AN EBCDIC ZERO < 



• JCAROSJNOWa • 
•IS REPLACED BY • 
•XJTEST £ 4032a/. 

• 256 • 



ADD 

A1A3 

|A1DEC| 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



IS JNOW 
LESS THAN 
JLAST . 



JNOW 

IS REPLACED BY 

JNOW £ 1 



• JCARDZJLASTa • 
•IS REPLACED BY »X. 
•-JCARDXJLASTn-l« 



YES .• IS JSIGN 
...... EQUAL TO 

». 2 



.X. 
X 
EXIT 
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ADD 
|A1A3 
A1DEC 
|A3All 
CARRY 
DECA1 
DIV 

DPACK 
DUNPK 
EDIT 
FILL 
GET 
ICOMP 
IOND 
KEYBD 
MOVE 
MPY 
NCOMP 
NSIGN 
NZONE 
PACK 
PRINT 
PUNCH 
PUT 
P1403 
P1442 
READ 
R2501 
SKIP 
STACK 
SUB 
S1403 
TYPER 
UNPAC 
WHOLE 
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A1A3 SUBROUTINE 



****A1********* 

t * 

t START AIA3 * 
* i 

*************** 



*****gl ******* **« 



ShT SWITCH AT * 
Jl TC A1A3 * 



******* ********* t 



= ****(,! ********** 



***************** 



**#**0l ********* 

* CREATE THE 

* ADDRESSES OF 

* JCARO(J) AND 

* KCARO(K) 

***************** 



***** El ********** 

* * 

* CALCULATE * 

* JLAST-Jtl THE * 
*WI0TH OF JCARD * 

* * 
***************** 



*****F1 ********** 

* LOAD INDEX * 
♦REGISTER I WITH* 
♦THE ADDRESS OF * 

* KCARD(K) * 

* * 
***************** 



*****^1 ********** 

* LOAD INDEX * 
♦REGISTER 2 WITH* 

* THE WIDTH OF * 

* JCARO * 

* * 
***************** 



**** 

X 
*****H1 ********** 

* LUAD THE * 

* ACCUMULATOR * 

* WITH ThE NEXT * 
*JCARD CHARACTER* 

* * 
***************** 



YES .* JU IS *. 
...*. SWITCH A1A3 .* 
. *. .* 

. *. .* 

X *. .* 

**** * NO 

* * 

* A5 * 

* * 
**** 



****A2********* 
it < 

> START A3A1 < 
it * 

*************** 



*****B2 ********** 



SET SWITCH AT * 
Jl TO A3A1 * 



(****«*«*« 



Kl 



*. 



.* IS 
*. INTEGER 
♦.NEGATIVE .* 
*. .* 
*. .* 
* YES 



*****C 2 ********** 

* * 

* * 
♦DIVIDE BY 160C * 

* * 

* * 
***************** 



****D 2**** ****** 
* 
GET * 
VALUE* 



* ADD 20 TO 
,*THt FIRST 



***********4 

**** 

* * 

* E2 *. .. 

* * 
**** 

X 
«****E2**** 

* ADD 32CC- 

* ADJUST FO 

* NEGATIV 

* INTtGE 

* * 
***************** 



****** 
TO * 
R A < 
E * 

R « 



*****p 2**** ****** 

* * 
♦DIVIDE BY 16CC * 

* TO GET THE ♦ 

* FIRST VALUE ♦ 

* * 
***************** 



*****G2**** ****** 



SAVE FIRST 
VALUE 



***************** 



*****H 2** ******** 

* * 
♦DIVIDE BY AC TO* 
*GtT THE SECOND * 

* VALUE * 

* * 
***************** 



*****j2 ********** 



SAVE SECOND 
VALUE 



t ******* ********* 



*****K2**** ****** 
*USc THIRD VALUE* 
*Ai SUBSCRIPT TO* 

* LOOKUP THIRD *. 

* CHARACTER * 



**** *£3********** 



* STCPE THIRD * 

* CHARACTER * 



***************** 



*****B -a ********** 

* USE SECOND * 

* VALUE 4S * 

* SUBSCRIPT TO * 

* LOCKUP SECCNC * 

* CHARACTER * 
***************** 



*****£ 3********** 



************ 



«*** *D3********** 
♦USE FIRST VALUE* 
*AS SUBSCRIPT TO* 

* LOOKUP FIRST * 

* CHARACTER * 



************* 



<*** 



*****£ 3* ********* 



STCPE FIRST 
CHARACTER 



***************** 



*****F3********** 



♦ DECREI-FNT INDEX* 
♦REGISTER 1 RY 3* 



«*** ************* 



*«***G3****K 



***** j 3* ********* 

* * 

* RESTCRE INDEX * 
♦REGISTERS 1, 2t* 

* AND 3 * 

* * 
***************** 



***«K3********* 
t * 

♦ EXIT * 

* * 
*************** 



***< 

« AA 
**** 



*****A4*********« 

* USE SECOND ♦ 

* CHARACTER TO * 
*SEARCH TABLE TO* 
*GET THE NUMeER * 

* * 
***************** 



*****Q4********ft* 

♦SUM THIS NUMBER* 
♦WITH THE THIRD * 
♦NUMBER ANO SAVE* 
♦ THE RESULT ♦ 



i*********m 



:***** 



*****C4**** ****** 

* USE FIRST * 

* CHARACTER TO * 
♦SEARCH TABLE TO^ 
♦GET THE NUMeER ♦ 

* * 
***************** 



*****04********** 
♦SUM THIS NUMBER* 

* WITH THE * 
♦PREVIOUS SUM TO* 

♦ GET THE RESLLT * 



****** 



c******** 



♦DECREMENT INDEX* 




♦REGISTER 2 eY 1* 




* * 




* * 




***************** 


• 


.X ...a 




X 




.*. 




H? *. 




. * *. 




NO .* IS *. 




. ..*. F IFLD WIDTH .♦ 




♦. ZFRC .♦ 




♦ . .* 




X *. .* 




**** * YES 




* 




HI * 




* 




**** 





*****E4**** ****** 

* * 

* STCRfc THE * 

* RESULT IN THE * 

* KCARD FIELD * 

* * 
***************** 



*****F4**** ****** 



♦DECREMENT INDEX* 
♦REGISTER 2 EY 1* 



***************** 



*****G^ ********** 



♦DECREMENT INDEX^ 
♦REGISTER 2 EY 1* 



***************** 

**** 

* * 

* HA *... 

* * . 
**** 

X 
*****H4 ********** 

* * 

* LOAD THE * 

* ACCUMULATOR * 

* WITH A BLANK * 

* * 
***************** 



*****j 4**** ****** 

* SAVE THE * 
♦ACCUMULATOR THE* 

* SECOND * 

* CHARACTER * 

* * 
***************** 



■■*** 



<******** 



*****K4********** 

* * 

* LOAD THE * 

* ACCUMULATOR * 

* WITH A BLANK * 

* * 
***************** 



***** At>** ******** 

* SAVE THE * 
♦ACCUMULATOR AS ♦ 

♦ THE FIRST ♦ 

* CHARACTER * 

♦ * 
c*** ********** 



**« 



*****B5** ******** 



DECREMENT INDEX* 
♦REGISTER 2 BY 1* 



***************** 



.* ♦. 

YES .♦ IS ♦. 

...*. FIELD WIDTH .* 
*. Zt*0 .* 
*. .* 

X *. .* 

**** * no 

* * 

* HA ♦ 



***** 05** ******** 

* LCAD THE * 

* ACCUMULATOR * 

* WITH THE NEXT * 
*JCARC CHARACTER* 

* * 
***************** 



*****E5** ******** 

* SAVE THE * 
♦ACCUMULATOR THE* 

* SECOND * 

* CHARACTER * 

* * 
***************** 



*****P5 ********** 



♦ DECREMENT INDEX* 
♦REGISTER 2 BY 1* 



***************** 



G5 *. 

YES .*' IS **. 

,...*. FIELD WIDTH .* 
*. ZERO .* 
* . .* 

*. .* 
* NU 



*****H5 ********** 

* LOAD THE * 

* ACCUMULATOR * 

* WITH THE NEXT * 
♦JCARO CHARACTERS 

* * 
***************** 



*****j5** ******** 

* USE THE * 
♦ACCUMULATOR TO * 
♦SEARCH TABLE TO* 
♦GET THE NUMBER * 

* * 
***************** 



*****K5 ********** 

* SAVE THIS * 

* NUMBER FOR * 

* LATER * 

* ACCUMULATION * 

* * 
***************** 



E2 < 
>*** 



> AA * 
**** 
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CARRY SUBROUTINE 



START 



> NCARY • 
►IS REPLACED BY • 
• • 



JNUW 

IS REPLACED BY 

JLAST 



JTEST 

IS REPLACED BY 

JCARDSJNOWn t 

NCARY 



NCARY 

IS REPLACED BY 

JTEST / 10 



» JTEST 
•IS REPLACED BY 
• JTEST - 10 • 
» NCARY 



IS JTEST 
LESS THAN 
. ZERO 



• 
• 
• IS 

• 
• 


JTEST • 

REPLACED BY • 

JTEST I 10 » 






• IS 


NC 
REPL 
NCAR 


iRY • 
\CED BY • 
1 - 1 • 


... 


....X 





> JNUW 

IS REPLACED BY 

> JNQW - 1 



NU .» IS JNUW •< 

LESS THAN . 

». J .• 



KARRY 
IS REPLACED BY 

t NCARY 



X 
EXIT 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY | 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER. 

UNPAC 

WHOLE 



JCARU%JNOV»n 

S REPLACED BY 

JTEST 
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ADD 
A1A3 
A1DEC 
A3A1 
CARRY 
iDECAll 
DIV 

DPACK 
DUNPK 
EDIT 
FILL 
GET 
ICOMP 
IOND 
KEYBD 
MOVE 
MPY 
NCOMP 
NSIGN 
NZONE 
PACK 
PRINT 
PUNCH 
PUT 
P1403 
P1442 
READ 
R2501 
SKIP 
STACK 
SUB 
S1403 
TYPER 
UNPAC 
WHOLE 
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DECA1 SUBROUTINE 



• START « 
i « 

••••••••••••••a 



JSIGN 

S REPLACEO BY 

4 



NO .» IS « 

...•.JCARDXJLASTn 

•.NEGATIVE .< 



• JSIGN 
•IS REPLACEO BY 

• 2 



• JCAROfcJLASTa t 
•IS REPLACED BY « 
•-JCARDSJLASTa-H 



JNOW 

IS REPLACED BY 

J 



► JTEST 

US REPLACED BY 

► JCARDXJNOWa 



IS JTEST •. 

LESS THAN . 

ZERO .• 



.• IS JTEST ». NO . • NER • 
. LESS THAN ...... »IS REPLACED BY • 

». 10 .• • JNOW • 
• • . • • • 


• YES 
X 




JCARDXJNOWa • 

IS REPLACED BY • 

256 • JTEST - • 

4032 • 




!x 





JNOW 

IS REPLACED BY 

JNOW & 1 



IS JNOW 
LESS THAN 
JLAST . 



-»—»-»—* 
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DIV SUBROUTINE 



YES .»IS KLAST - ». 
...». KSTRT-JSPAN .« 
•.NEGATIVE .» 



• IS « 

KLOW 
•.POSITIVE .< 



KCARD,KLOWi 
KSTRT, 



• JFRST 

•IS REPLACED BY 

• J 



• IS ». YES 
JCAROSJFRSTo ...... 

•.POSITIVE .» 



START 



•CLEAR AND SAVE • 

• SIGNS ON • 
•JCARO AND KCARD« 

• FIELDS • 



JSPAN 

IS REPLACED BY 

JLAST - J t 1 



KSTRT 

IS REPLACED BY 

K - 1 



> KLOW 

>IS REPLACED BY 

► K - JSPAN 



► A3 • 

» • 

• • •• 



• *•• 

> • 

> El «X.« 

> • < 

• •«• 



IS JFRST 
LESS THAN 
JLAST . 



• JFRST 
.X«IS REPLACED BY 

• JFRST £ 1 



• NER 

►IS REPLACED BY 

» KLAST 



X 

'nsign' 



KCAROiKLAST 
JSPAN, JSIGN 

KSIGN.KNOW 



X 
EXIT 



A3 « 



JHIGH 

IS REPLACED BY 

JCARDSJFRSTn 



KPUT 

IS REPLACED BY 

KLUW C 

JLAST - JFRST 



KSTOP 

IS REPLACED UY 

KLAST L JFRST 

- JLAST - 1 



KM 
IS REPLACED BY 
> KSTRT 



• ••i 
i 
► E3 



• MULT « 
•IS REPLACED BY « 
•S10 • KCARD?KMU« 
•tKCARDSKMtlan/ , 
» JHIGH « 



,\0U0 

IS REPLACED BY 

MULT 



JNOW 
IS REPLACED 
JNUW I 1 



• ••• 
t i 
» A5 t 



, • IS MULT « 
■GREATER THAN 
•. ZERO .« 



• KNOW 
,...X«IS REPLACED BY 
X • KM £ 1 



• KCAKDSKPUTn 
•IS REPLACED BY 

• NQUO 



• KPUT 

•IS REPLACED BY 

• KPUT £ I 



NO .» IS KM 
,..». LESS THAN 
•. KSTOP . 



• KM 
,X»IS REPLACED BY 

• KM £ I 



JNOW 

IS REPLACED BY 

JFRST 



- KCARDSKNOwn 
IS RbPLACED BY 

k;a<u*knowu - 

MULT • 
> JCARlUJNUWu 



KNOW 

IS REPLACED BY 

KNOW G I 



IS JNOW 
LESS THAN 
JLAST . 



X 

CARRY 



KCARD.KM, 
KNOW-l.KNUW 



IS KNOW 

LESS THAN 

ZERO 



KCAKDSKMu 

IS REPLACED BY 

KCARU%KM3 £ 

10 • KNOW 



• MULT 

•IS REPLACED BY 

• -1 



• NQUO 

► IS REPLACED tlY 

i NQUO - 1 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 



DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



-129- 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 
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EDIT SUBROUTINE 



I EDIT 
FILL 
GET 
ICOMP 
IOND 
KEYBD 
MOVE 
MPY 
NCOMP 
NSIGN 
NZONE 
PACK 
PRINT 
PUNCH 
PUT 
P1403 
P1442 
READ 
R2501 
SKIP 
STACK 
SUB 
S1403 
TYPER 
UNPAC 
WHOLE 



X 

'nzone* 



NZONE 
JCARD.JLAST, 

'♦.NSIGN 



NDUMP 

IS REPLACED BY 

EBCDIC BLANK 

3516448a 



MONEY 

IS REPLACED BY 

EBCDIC BLANK 



• NZRSP 

•IS REPLACED BY 

• 



• KNOW 

•IS REPLACED BY 

• KLAST 



JNOW 

S REPLACED BY 

JLAST 



•••••• • 



• •• 

HI *.. 

• • » 



• 17* 

KTEST 

S REPLACED BY 

KCARDSKNOWn 



• ••• 

I B3 * 



IS KTEST •. NO 
NEGATIVE .»... 



•• »34» « 
IS KTEST 
EQUAL TO 

. 1644B 



.• «13» •. 
YES .• IS KTEST i 

EQUAL TO 

». 23616 .« 



IS REPLACED BY 
> JCARDSJJNOWn 



.» «1A* « 
IS KTEST 
EQUAL TO 

. 23360 



• 13« • 

NDUMP • 

IS REPLACED BY • 

KTEST • 



• 28« 

MONEY 

IS REPLACED BY 

KTEST 



i *19» • 

► NZRSP • 

►IS REPLACED BY • 

• KNOW • 



•••••••• 

• ••• 

• H2 ».. 

• » •• 



•••••*• 



.» »20» • 

IS JNOW 

LESS THAN 

J 



.• »33» « 

IS KTEST 
EQUAL TO 
. -4032 







• KCARDSKNOWn » 
•IS REPLACED BY • 

• KTEST • 






• JNOW • 
•IS REPLACED BY • 

• JNOW - 1 » 







NO .» IS KNOW 

...«. LESS THAN 

•. K 



i HI • 

h * 



• IS •. 

NZRSP 
•.POSITIVE .» 



. • »9» < 
IS 
KTEST 
.NEGATIVE 



.• «36» • 
XYES .• IS KTEST 
.». EQUAL TO 
•. 16448 



• 23» 

IS 
KTEST 
COMMA 



• 25« 

NZRSP 

IS REPLACED BY 

KNOW - 1 



• ••• 

• < 

• K3 < 



• 11» 

KNOW 

IS REPLACED BY 

KNOW - 1 



NZONE 

JCARD.JLAST, 

NSIGN. KTEST 



IS JNOW 

LESS THAN 

J 



,» «29» « 
IS NSIGN 
EQUAL TO 

2 
• • . • 
• • «• 
NO 



FILL 

KCARD.K, 
KLAST, 23616 



!.X» K4 < 
■ • • * 
X •••• 



.. *3i>« • 
NO .» IS KTEST 
...«. EQUAL TO 
». -4032 



• YES 
X 



> K3 • 
• ••• 



.» »32» •. 
• IS KTEST •. NO 
EQUAL TO 

>. 24640 •• 



• K4 • 

• • 
• ••• 



• 30» 
EXIT 



> IS 
KTEST 

>. NEGATIVE 



• n» 

IS 

KTEST 

R 



• »6» 
•KCARDXKLAST-la 
•IS REPLACEa BY 

• 16448 



• k:ard*klastu 
•is replaced by 

• 16448 



.• «3« •. 

,NU .» IS NZRSP ». 
...•.GREATER THAN •• 
». .• 



FILL 

KCARD.K, 
NZRSP, NDUMP 



• KCARDSNZRSPa 
.•IS REPLACED BY 

• MONEY 



• B4 • 

• • 

• ••• 
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****Al ********* 
' START DUNPK ' 
*************** 



*****bi ********** 



**************** i 



****A2********* 
t < 

« START DPACK < 

*************** 



*****£ 2** ******** 



SET SWITCH AT * 
K2 TU OPACK * 



:**************** 



*****C 2**** ****** 

* * 

* SAVE INDEX * 
♦REGISTERS 1 AND* 

* 2 * 

* * 
***************** 



*****D 2 ********** 



*CKEATE AuDRESS 
► OF JCARD(J) 



*##**£ 2 ********** 



***************** 



***************** 



*****G2 ********** 

* LOAD INDEX * 
♦REGISTER 1 WITH* 

* ADDRESS OF * 

* KCARD(Kl * 

* * 
*********** ****** 



*** 



*****H 2** ******** 

* LOAD THE * 

* ACCUMULATOR * 

* WITH THE NEXT * 
♦JCARD CHARACTER* 

* * 
***************** 



***** j 2 ********** 

* * 

* LOAO INDEX * 
♦REGISTER 2 WITH* 

* 4 * 

* * 
***************** 



DUNPK SUBROUTINE 



X 

.*. 
A3 *. 



**** 
YES * * 

>....X* C4 1 



**** 

* * 

* A5 * 



*****A5** ******** 

* SHIFT AND * 

* ROTATE TO PUT * 

* DIGIT IN LOW * 

* ORDER OF THE * 

* EXTENSION * 
******* ********** 



*****£ 3*** ******* 



♦ PICK UP A DIGIT* 

* OF THF WORD i 



4****C3********** 



***************** 



*****E 3********** 

* * 
*OFCREfENT INDEX* 
♦REGISTER 1 BY 1* 

* * 

* * 
**** ************* 



***************** 



,* IS *. NO 

, COL'NT ZFRO .*... 
*. .* 



IS * 
FILLER 

. NEEDEO .* 
*. .* 
*. .* 
* YES 


t* 


X 

**C4********** 

PUT IN * 

NECESSARY * 

AMOUNT OF * 

FILLER * 



* IS THIS *. 
JCARO(JLAST) . 
*. .* 



***************** 



t*Q4********** 



r****£4**** ****** 



:**************** 



*****P4**** ****** 



***************** 
**** 



*****G^ ********** 

* * 

* STORE THE * 
♦ACCUMULATOR IN * 

* KCARD * 

* * 
***************** 



*****H4 ********** 

* * 

* RESTORE INCEX * 
♦REGISTERS 1 AND* 

♦ 2 * 

♦ * 
***************** 



*#**j4 ********* 
; EXIT * 

*************** 



#****C5 ********** 



***************** 



STORE PACKED * 


.* IS *. NO 


i}ATA IN KCARD * 


*. COUNT ZERO .*.. 


* 


*. .* 


* 


* . .♦ 


*************** 


*. -* 




* YES 



*****£5** ******** 



***************** 



*****P5** ******** 



***************** 



' HZ * 
< 4 

**** 
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PACK 

PRINT 
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STACK 
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S1403 
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WHOLE 



K2 *. 
**** .* *. 

* YES .* IS *. 
< A3 *X... .*. SWITCH 

* *. DUNPK .* 
**** *. .* 

*. .* 
* NO 



* A5 * 

* * 
**** 
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• JNOW 

•IS REPLACED BY 

» J 



• JCARDZJNOWa 
•IS REPLACEO BY 

• NCH 



• JNOW 

•IS REPLACED BY 

• JNOW £ 1 



.» IS JNOW •. NO 

•.GREATER THAN 

». JLAST •• 



X 
EXIT 
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GET FUNCTION 



X 

NZONE 



NZONE 

JCARD.JLAST, 

<►, NSIGN 



• GET 

•IS REPLACED BY 

• 0.0 



JNUW 

IS REPLACEO BY 

J 



> JTEST 

IS REPLACEO BY 

> JCARDSUNOWn 



• JTEST 
•IS REPLACED BY 
•AN EBCDIC ZERO 



,• IS JTEST •. YES 
LESS THAN ...... 

• .AN EOCDIC* 
•.ZERO .• 



GET 

IS REPLACED BY 

0.0 



• GET 

•IS REPLACED BY 
•10«GET£SJTEST£ 

• 4032U/256 



• JNOW 
.X«IS REPLACEO BY 

• JNOW L 1 



,• IS JNOW « 
.GREATER THAN 
». JLAST .« 



GET 

IS REPLACED BY 

SHIFT • GET 



NZONE 

JCARO.JLAST, 

NSIGN, JTEST 



IS NSIGN ». YES 
EQUAL TO ...... 

2 .» 



GET 

IS RtPLACED ttY 

MINUS GET 



X 
EXIT 
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PACK 
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ICOMP FUNCTION 



•CLEAR AND SAVE • 

• SIGNS ON » 
•JCARO AND KCARU* 

• FIELDS • 



• KSTRT 

•IS REPLACED BY 

• KLAST C J - 

• JLAST - 1 



.• IS K « 

•.GREATER THAN 

». KSTRT .« 



ICOMP 

IS REPLACED BY 

-KSIGN 



• KNOW • 
•IS REPLACED BY • 

• K • 



• • •• 
• IS « 

KCARDSKNOWn 
•.POSITIVE .« 



• KNOW 

►IS REPLACED BY 

> KNOW E 1 



IS KNOW < 
LESS THAN 
. KSTRT .< 



KSTRT 

IS REPLACED BY 

KSTRT C 1 



KNOW • 

IS REPLACED BY • 

KSTRT £ 1 • 



JHASH • 

•IS REPLACED BY • 

ZERO • 



KSTRT • 

IS REPLACED BY • 

J • 



> JHASH 

US REPLACED BY 
* JHASH £ 

> JCARD*KSTRTa 



• ICOMP 
•IS REPLACED BY 
•JCARDSKSTRTn - 

• KCARDXKNOWD 



IS ICOMP 
EQUAL TO 
. ZERO 



,• IS •. 

.KSI3N • JSISN. 

•.LESS THAW.» 

•.ZERO .* 



IS KSTRT 
LESS THAN 
JLAST . 



y KNOW 

•IS REPLACED BY 

y KNOW £ 1 



• RESTORE SIGNS • 

• ON • 
•JCARO AND KCARD* 

• FIELDS • 



X 
EXIT 



NO ,»IS JSIGN • •. 

..•.KSIGN • JHASH. 

•.NEGATIVE .• 



ICOMP 
>IS REPLACED BY 

* 1 



ICUMP • 

IS REPLACED BY • 

JSIGN • ICOMP • 
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START 
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...... X 






) 


< 




• •• 




• • •• 




• * *• 


!yes . 


• ANY •. 


...X*. 


INTERRUPTS . 




•. PENDING .» 




»• • • 




• • • * 






•NO 






: 


• 




• 


EXIT 


• 
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MOVE SUBROUTINE 


A1A3 








A1DEC 








A3A1 








CARRY 








DECA1 


• START • 

» » 




DIV 


"| " 




DPACK 


* 






DUNPK 


X 






EDIT 
FILL 


» • 

• JNUW • 
•IS REPLACED BY • 
» J • 

• • 




GET 






ICOMP 


. X.. ........... 








IOND 










KEYBD 
|MOVE| 


• KNOW • 
•IS REPLACED BY • 

♦ K £, JNOW - J • . 




MPY 






NCOMP 

NSIGN 

NZONE 










• KCARDSKNOWn • 
•IS REPLACED BY • 

• JCARDSJNOWn • 


• JNOW • 
•IS REPLACED BY • 

• JNOW £ 1 • 




PACK 




X 




PRINT 










PUNCH 


• •. 








PUT 


• • •« 
.» IS JNOW •. YES 

• 1 PR^ TU AM • ~ 








P1403 


•. JLAST .• 

• • . • 








P1442 


"•NO 






READ 








R2501 








SKIP 


• • 

• EXIT • 

• • 




STACK 






SUB 








S1403 








TYPER 








UNPAC 








WHOLE 
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MPY SUBROUTINE 



NER 

IS REPLACED BY 

KLAST 



• 






» 


• 


KSTRT 




• 


X»IS 


REPLACEO 


BY 


• 


• K 


- JLAST £ J 


• 


• 


-1 




• 



.* IS KSTRT « 
.GREATER THAN 
». ZERO .« 



•CLEAR AND SAVE • 

• SIGNS ON ♦ 
•JCARD AND KCARD* 

♦ FIELDS • 



X 

"ill* 



KCARD, KSTRT, 
K-1,0 



JFRST • 

IS REPLACED BY » 

J • 



,• IS • . YES 
■JCARDSJFRSTn .*.... 
••POSITIVE .» 



IS JFRST 
LESS THAN 
. JLAST . 



JFRST 

IS REPLACED BY 

JFRST £ 1 



X 

'fill' 



KCARD.K, 
KLAST, 



> J2 < 

• ••• 



NSIGN 

••-•-•-»-•-•- 

JCARD, JLAST, 

JSIGN.JNOW 



JNOW 

IS REPLACED BY 

JNOW £ 1 



EXIT 



KM 

IS REPLACED BY 

K 



• MULT 

•IS REPLACED BY 

• KCARDSKMn 



> KM 
IS REPLACED BY 

t KM £ I 



.» IS MULT •. NO 

• .GREATER THAN .• 

•. ZERO .» X 



IS KM 
LESS THAN 
, KLAST . 



• KCARDSKMa 
•IS REPLACED BY 

• ZERO 



• KNOW 

•IS REPLACED BY 

• KM £ JFRST 

• - JLAST 



> JNOW 
IS REPLACED BY 
JFRST 



• KCARDXKNOWn 
•IS REPLACED BY 

• MULT • 

• JCARDXJNOWn £ 

• KCARDSKNOWn 



► KNOW 

US REPLACED BY 

► KNOW £ 1 



IS JNOW 
LESS THAN 
. JLAST . 

• • •• 



X 

• NSIGN 
•-•-»-•-•-»-»-« 

• KCARD, KLAST, 
•JSIGN • KSIbN, 

• KNOW 
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NCOMP FUNCTION 



• 


START 




• 


• IS 


JN 
REPL 


DW 

\CED 

1 


BY 


• 
• 




X.. 


... 


•• 


• IS 

• K 


KNOW 
REPLACED 
C JNOW - 


BY 
J 





• NCUMP < 
•IS REPLACED BY < 

• JCARDXJNOWn/8 « 
•- KCAR0XKN0Wa/8< 



IS NCOMP 
EQUAL TO 
, ZERO 



• JNOW 

•IS REPLACED BY 

• JNOW & I 



.• IS JNOW * 

•.GREATER THAN 

». JLAST .« 
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NSIGN SUBROUTINE 



• NOLDS • 
•IS REPLACED BY • 

• 1 • 



• JTEST • 
•IS REPLACED BY • 

• JCAROXJa • 



NO .« IS JTEST 
...». LESS THAN 
•. ZERO 



• NOLDS 
•IS REPLACED BY 

• -1 



LOW .-NEWS-JTEST •. HI 

...». IS 



COMPARED 
TO 
•.ZERO .• 



>• IS NEWS «. YESX 
.GREATER THAN .». 

». ZERO .» 



• JTEST • 
•IS REPLACED BY • 

• -JTEST - I • 
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t JCARDXJa 
US REPLACEO BY 
» JTEST 



X 
EXIT 
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NZONE SUBROUTINE 



JTEST 

IS REPLACED BY 

JCARDSJn 



IS • . 

JTEST 
.NEGATIVE .• 



» IS JTEST • . NO 
EQUAL TO AN .»... 
>. EBCDIC .• 
•.ZERO .• 



IS NEHZ 

EQUAL TO 

2 



• JCARDSJn 
•IS REPLACED BY 

• 24640 

• ^EBCDIC - n 



• IS JTEST 

, EQUAL TO 
♦.24640 X-c 



X 
EXIT 



» NOLDZ 
•IS REPLACED BY 
• 5 C SJTEST - 
» 4096D/4096 



NO .• IS NOLDZ 

,..». LESS THAN 

•• 5 



IS NEWZ 

LESS THAN 

5 



• JCARDXJn 
•IS REPLACED BY 
•JTEST £ 4096 • 

• 35NEWZ - NOLDZn 



NOLDZ 

IS REPLACED BY 

2 



• JTEST 
•IS REPLACED BY 

• -12224 

• SEBCDIC 11-On 
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PACK/UNPAC SUBROUTINE 



• START 

• 
•••••••i 


UNPAC » 

• 

( 


• START PACK • 

• • 












) 




YES 


X 

• • • 
.» B4 
.• IS 


• SET SWITCH AT * 

• B4 TO • 

• UNPAC • 

• • 


• SET SWITCH AT * ! 

• B4 TO • 

• PACK « 






X 




•• PACK 

• • 

• • • • 










x ! 






• SAVE • ! 
•INDEX REGISTER • 

• 1 • . 

• • 


• SHIFT HIGH • 
•ORDER CHARACTER* 
•TO LOW ORDER OF* 

• EXTENTION • 

• • 





•CREATE ADDRESS 
• OF JCARDtJn 



•CREATE ADDRESS 
• OF KCARDSKn 



• LOAD INDEX • 
•REGISTER 1 WITH" 

• ADDRESS OF • 

• KCARDSKn • 



• LOAD ACCUM. • 

• WITH NEXT • 
•JCARD CHARACTER* 



• LOAD ACCUM. • 

• WITH NEXT • 
•JCARD CHARACTER* 



ROTATE ACCUM. 

AND EXTENTION 

i TO CREATE A2 

FORMAT 



•STORE ACCUM. IM< 

• KCARD USING < 
•INDEX REGISTER ■ 

• 1 « 



DECREMENT INDEX 
REGISTER 1 BY 

1 



NO •• HAS 

...♦.JCARDSJLASTt 
•.BEEN DONE. 



CREATE 
RETURM 
ADDRESS 



•REPOSITION THE 

► HI3H ORDER 

► CHARACTER 




• PLACE EBCDIC • 
•BLANK, HEX 40, • 
•IN LOW ORDER 0F» 

• ACCUMULATOR • 



•STORE ACCUM. IN« 

• KCARD USING * 
•INDEX REGISTER * 

• 1 « 



►DECREMENT INDEX* 
» REGISTER 1 UY • 
» 1 • 



•SHIFT CHARACTER* 

• IM EXTENTION • 

• TO HIGH ORDER • 
•OF ACCUMULATOR • 
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• PLACE EBCDIC « 

• BLANK, HEX <tO, « 
•IN LOW ORDER OF' 

• ACCUMULATOR « 



X 
EXIT 
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A1A3 
AIDEC 
A3A1 
CARRY 


PRINT/SKIP SUBROUTINE 




DECA1 


• START PRINT * 

• • 


» START SKIP • 

• • 


DIV 
DPACK 






DUNPK 
EDIT 


X 

• • • • • 

!yes .•"* is **•. 

...X*. PRINTER .• 
•. BUSY .• 

* • • * 

**«N0 

X 

• SAVE INDEX • 

• REGISTER 1 « 

• • 


) 




X 
• • • 

NO .•"* IS **•. 


FILL 
GET 
ICOMP 
IOND 


( 


•.REQUESTED.* 
• • •• 

* . *• 
• YES 

5 


KEYBD 
MOVE 


• PRNTl • 

•-•—•-♦—•-•-•-•-a 
•SKIP REQUESTED • 

• • 

• • 


• CHANGE PRNTl • 
•CALL, 2000, TO • 

• 2010, AT G2 • 


MPY 

NCOMP 

NSIGN 

NZONE 

PACK 


X 








• SET UP • 

• ADDRESSES FOR • 

• JCARD • 

• • 




. 




PRINT : 

• 


PRINT I ' 




PUNCH 


X 




PUT 
P1403 


* REVERSE AND • 

• PACK JCARD • 




P1442 
READ 
R2501 
|SKIP| 
STACK 
SUB 
S1403 






•PRNTl G2» 

•2000, AREA, ERROR* 

• • 

• • 




X 




TYPER 
UNPAC 


• RESTORE INDEX » 

• REGISTER 1 • 

• • 

• • 




WHOLE 










) 


< 






• • 

• EXIT • 
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. DIGS 
IS REPLACED BY 
ABSSVARatADJST 

TRUNCATED 



.• IS N « 
.GREATER THAN 
». ZERO .« 



JNOW 
IS REPLACED BY 

ONE 



• JNOW • 
•IS REPLACED BY «X. 
» JNOW £ 1 • 



DIGS 
IS REPLACED BY 

DIGS / 10. 
> TRUNCATED 



.» IS JNOW 
>. LESS THAN 
• . N 



JNOW 

IS REPLACED BY 

JLAST 



» DIGT 
►1 S REPLACED BY 
> DIGS / 10.0 
t TRUNCATED 



• JCARDSJNOWn « 
•IS REPLACED BY « 
•256 • IFIX?DIGS« 

• -10.0 • DIGTa « 

• -4032 « 



• OIGS 

•IS REPLACED BY 

• DIGT 



> JNOW • 
>IS REPLACED BY «X. 

> JNOW - 1 • 



.• IS JNOW * 

►.GREATER THAN 

• . J .« 



NU .• IS VAR 
...». LESS THAN 
•. ZERO 



NZONE 

JCARD, JLAST, 

2. JNOW 
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P1403 SUBROUTINE 



****g 2 ****-***** 
k 4 

> START P14C3 * 

t < 

*************** 



t ****C2** ******* = 



[*********** 



*****D2 ********** 

* * 

* SET UP * 

* ADDRESSES FOR * 

* JCARJ * 

* * 
***************** 



*****£ 2**** ****** 



REVERSE AND 
PACK JCARD 



***************** 



*****F 2**** ****** 

* CONVERT I/O * 

* AREA FROM * 
*£6CDIC TO 14C3 * 

* CODE * 

* * 
***************** 



****B4********* 
t < 

' START S14C3 < 
' t 

*************** 



,* IS *. 

, SUPPRESSION . 
*. REQUESTED.* 



♦SKI P REQUESTED * 
* * 

***************** 



***** 04**** ****** 

* * 

* CHANGE PRNT3 * 
♦CALL, 2CCC, TO * 

* 20 IC, AT h2 * 

***************** 



.X. 
X 

.*. 



YcS .* IS *. 

...*. PRINTER 

*. BUSY .* 



*****H 2* ********* 
*PRNT3 _ * 



*20CCtAREA, ERROR* 
* * 

***************** 



*****j 2**** ****** 



RESTORE INOEX 
REGISTER 1 



****************> 



****«?********* 

i A 

t EXIT * 

t * 

*************** 
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P1442 SUBROUTINE 



****A3******** 

> START P1442 
*************, 



SAVE INOEX 
REGISTER I 



»*** ******* 



«****C3********** 

* * 

* SET UP * 

* ADDRESSES FQR * 

* JCARC * 



*****C3********** 

* * 

* REVERSE JCARC * 

* * 
***************** 



JC ARC( JLAST) , * 
AREAC1, COUNT * 
|c *************** 



*****F3********** 



, AREA.ERRCR* 



******** 



«****£ 3* ********* 

* * 

* REVERSE JCARC * 

< * 

<#***********#*** 
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NC .* IS *. 

...*. PUNCHING .* 

♦.FINISHED .* 
*. .* 



* RESTCRE INCEX * 

* RFGISTER 1 * 



*********** 



*** *K3********* 
t 4 

t EXIT * 

t * 

*************** 
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• START PUNCH • 

• • 


X 




• SAVE INDEX 
» REGISTER I 

• 
• 


• 

• 
• 
• 


* SAVE INDEX • 

• REGISTER I • 


X 




X 


ICOMP 
IOND 


• SET UP 

• AODRESSES FOR 

• JCARD 

• 


• 
• 


* SET UP • 

* ADDRESSES FOR • 

• JCARD • 

• • 


KEYBD 

MOVE 

MPY 


X 




X 


NCOMP 

NSIGN 


• CARD1 » 

•10CO.AREA, ERROR* 

• • 

• • 


• REVERSE • 

• JCARD • 

• • 

• • 


NZONE 
PACK 








X 


X 


PRINT 
| PUNCH | 


• SPEED • 

• 0010,AREA£1, • 

• JCARDSJLASTn, • 
•CHARACTER COUNT* 


• SPEED • 

* 0011, • 

* JCARDXJLASTn, « 

• AREA61, COUNT • 


PUT 

P1403 

P1442 


X 
• *• 

• * * • 

YES .»* ANY *« 
...«. ERRORS 

». •• 

». • * 

'•NO 


:• 


X 


IREADl 
R2501 


• CARD! • 

•2000, AREA, ERROR* 

• • 

• • 


SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 


• 








X 




• 
• 
• 
• 
• 


REVERSE • 
JCARD • 

• 
• 










WHOLE 


I NO .« 
...X*. 


X 

• •• 

• • *• 

READING *•• 
OR PUNCHING .« 
.FINISHED .• 





►YES 



RESTORE INDEX 
REGISTER 1 



X 
EXIT 
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CHART R2 



1130 COMMERCIAL 



R2501 SUBROUTINE 



t * 

t START R25' , l * 
> * 

*** ************ 



,******** 



SAVE INDEX 
RFGISTER 1 



**** ************, 



**** *C3********** 

* * 

* SET UP * 

* ADDRESSES FOR * 

* JCARD * 

* * 
***************** 



t****Q2*** ******* 



* FILL THE I/O 
*ARFA HUH CNES 



:******** 



*****E' 
<READl' 



*l r ' ,r ,AREA,EPRCR* 
* * 

***************** 



K,ARFAU. 
ARC< JLAST) 



> JC 

>CHA 
i*** 



**#*K ■$******* v** 

* 

PFVERSE JCARC * 

* 

* 

**************** 



NC .* READING *. 
..*. FINISHED .* 

**. .** 

* YES 




X 
*****%■$********** 

* * 

* RESTCRE INOEX * 

* REGISTER 1 *.... 

* * 

* * 
***************** 


****%j t ********* 
* 
....X* EXIT 
* 

*************** 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

[R2501| 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 
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ADD 


CHART ST 


A1A3 




A1DEC 




A3A1 




CARRY 




DECA1 




DIV 




DPACK 




DUNPK 




EDIT 




FILL 




GET 


• START • 


ICOMP 


* 


IOND 


• 


KEYBD 


X 


MOVE 
MPY 


• SELECT THE • 

ALTERNATE 

• STACKER • 


NCOMP 


1"*"* 


NSIGN 


* 


NZONE 


X 


PACK 
PRINT 


• EXIT • 

• • 




PUNCH 




PUT 




P1403 




P1442 




READ 




R2501 




SKIP 




I STACK! 




SUB 




S1403 




TYPER 




UNPAC 




WHOLE 





1130 COMMERCIAL 



STACK SUBROUTINE 
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CHART SU 



1130 COMMERCIAL 



SUB SUBROUTINE 



O.JSIGN 



X 

ADD 



•JCARD.J.JLAST, 
•KCARD,K f KLAST, 
* NER 



• NSIGN 

• JCAROtJLASTi 

• O.JSIGN 



X 
EXIT 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 



SUB 



S1403 
TYPER 
UNPAC 
WHOLE 
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ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

IKEYBDI 
MOVE 
MPY 
NCOMP 
NSIGN 
NZONE 
PACK 
PRINT 
PUNCH 
PUT 
P1403 
P1442 
READ 
R2501 
SKIP 
STACK 
SUB 
S1403 

ITYPER 
UNPAC 
WHOLE 



1130 COMMERCIAL 



TYPER/KEYBO SUBROUTINE 



START TYPER 



SAVE INDEX 
REGISTER 1 



► IS 
TYPEWRITER 
'. BUSY 



SET UP 

ADDRESSES FOR 

JCARD 



•MAKE CHARACTER 
•COUNT SIXTY IF 
• IT IS NOT 
« ALREADY 



• E8PRT • 

•-•—»-#-•-•—•-•—• 

• C000,AREAE1, • 

• AREAC1, • 
•CHARACTER COUNT* 



X 
TYPEO 

Iooo'arIa" 



START KEYBD • 



SAVE INDEX 
REGISTER I 



IS ». YES 
KEYBOARD .»X.. 
. BUSY .» 



SET UP 

ADDRESSES FOR 

JCARD 



•MAKE CHARACTER 
•COUNT SIXTY IF 

• IT IS NOT 

• ALREADY 



X 

TYPEO 

lOOOtAREA 



.• IS ». NO 

•. KEYBOARD ,»X.. 
•.FINISHED .• 



• SPEED 

•-•-•-•-•-•-•-< 

• OOlOtAREAtl, 

• JCARDJJLASTn, 

• COUNT/2 



X 
EXIT 
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1130 COMMERCIAL 



WHOLE FUNCTION 



» CALCULATE THE • 
►AMOUNT TO SHIFI* 
> RIGHT • 



IS 

AMOUNT 
ZERO 



• IS 

NUMBER ALL 

•FRACTIONAL. 

*. . • 



SET RESULT 

EQUAL TO 

ZERO 



• SHIFT RIGHT « 
► TO DROP « 

•FRACTIONAL PART* 



• SHIFT LEFT 

• TO FILL WITH 

• ZEROS 



• STORE RESULT • 



X.X. 
X 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE! 
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LISTINGS 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



0000 



22902000 



0000 
C0FE 
D005 
C002 
D028 
7005 
F06E 
7002 
0000 
C0FD 
0022 
6970 



0000 

0001 

0002 

0003 

0004 

0005 

0006 

0007 

0008 

0009 

00 0A 

000B 

000C 01 65800008 

000E C100 

000F 00 95800002 

00.11 0049 

0012 6004 

0013 0017 

0014 00 C5800002 
0016 00 95800001 
0018 80FE 



SUB 



IHFS 

MOX 

ADD 



SUB 



SUB 
ADD 



// JOB 

// ASM 

• NAME ADD (ID) 

** ADD/SUB SUBROUTINES FOR 1130 COMMERCIAL SUBROUTINE PACKAGE (ID) 

» LIST 

0008 01104000 ENT ADD ADD SUBROUTINE ENTRY POINT 

» CALL ADD(JCARD.J.JLAST»KCARD»KtKLAST»NER) 

* THE FIELD JCARD(J) THROUGH 

* JCARD(JLAST) IS ADDED TO THE 

* FIELD KCARD(K) THROUGH 
KCARD (KLAST). 
SUBTRACT SUBROUTINE ENTRY POINT 

CALL 5UB< JCARD. J. JLAST tKCARD.K. KLAST. NER) 
THE FIELD JCARD(J) THROUGH 
JCARD (JLAST) IS SUBTRACTED FROM 
THE FIELD KCARD(K) THROUGH 
KCARD ( KLAST )• 

ARGUMENT ADDRESS COMES IN HERE* 
PICK UP ARGUMENT ADDRESS* 
STORE IT AT ADD. 
IHFS LOAD THE INSTRUCTION TO CHANGE 
SWIT SIGN OF JCARD FOR SUBTRACT. 
ADD+3 START COMPUTING* 
X HFFFF-SWIT-1 CHANGE SIGN OF SUBTRHND 
•+2 SKIP OVER NEXT INSTRUCTION. 
«-* ARGUMENT ADDRESS COMES IN HERE. 
MDX LOAD SKIP OVER INSTRUCTION. 
SWIT STORE IT AT SWIT. 
1 SAVE1+1 SAVE IR1. 
U ADD PUT ARGUMENT ADDRESS IN IR1 
1 GET JCARD ADDRESS 
2 SUBTRACT JLAST VALUE 
DO+1 PLACE ADDRESS FOR ADD OR SUBTR 
ONE+l ADD CONSTANT OF ONE 
JPLUS+1 CREATE JCARDI JLAST) ADDRESS 

2 GET JLAST VALUE 
1 SUBTRACT J VALUE 
ONE+1 ADD CONSTANT OF ONE 
+ SKIP IF POSITIVE 
ONE+1 NEGATIVE OR ZERO-MAKE COUNT 1 
COUNT+1 STORE JCARD LENGTH 

3 GET KCARD ADDRESS 
KCRD1 PLACE IN CALLING SEQUENCE OF 
KCRD2 CARRY AND FILL SUBROUTINES 
5 SUBTRACT KLAST VALUE 
KCRD3+1 PLACE LOAD ADDR FOR ADD/SUB 

0022 D03A STO KCRD4+1 PLACE STORE ADDR FOR RESULT 

0023 D04F STO KCRD5+1 PLACE SUBTRACT ADDRESS AND 

0024 D050 STO KCRD6+1 STORE ADDR FOR NEG CARRY 

0025 80F1 A ONE+1 ADD CONSTANT OF ONE 

0026 D044 STO KCRD7+1 PLACE ADDR FOR SIGN CHANGE 

0027 D010 STO KPLUS+i PLACE ADDR OF SIGN OF KCARD 

0028 C106 LD 16 GET NER ADDRESS 

0029 D05E STO ERA+1 SAVE NER ADDRESS 

* CLEAR AND SAVE SIGNS ON JCARD 
« AND KCARD FIELDS. 
JPLUS LD L «-* GET SIGN OF JCARD 



ONE 



0019 
001 A 
001B 
001C 
001D 
001E 



4808 
COFC 
D03B 
C103 
0044 
D062 



001F 00 95800005 
0021 D037 



ENT 



DC 

LD 

STO 

LD 

STO 

MDX 

EOR 

MDX 

DC 

LD 

STO 

STX 

LDX 

LD 

S 

STO 

A 

STO 

LD 

S 

A 

BSC 

LD 

STO 

LD 

STO 

STO 

S 

STO 

STO 

STO 

STO 

A 

STO 

STO 

LD 

STO 



II 



II 



002A 00 C4000000 



CSP00010 
CSP00020 
CSP00030 
CSP00040 
CSP00050 
CSP00060 
CSP00070 
CSP00080 
CSP00090 
CSP00100 
CSP00110 
CSP00120 
CSP00130 
CSP00140 
CSP00150 
CSP00160 
CSP00170 
CSP00180 
CSP00190 
CSP00200 
CSP00210 
CSP00220 
CSP00230 
CSP0C240 
CSP00250 
CSP00260 
CSP00270 
CSP00280 
CSP00290 
CSP00300 
CSP00310 
CSP00320 
CSP00330 
CSP00340 
CSP00350 
CSP00360 
CSP00370 
CSP00380 
CSP00390 
CSP00400 
CSP00410 
CSP00420 
CSP00430 
CSP00440 
CSP00450 
CSP00460 
CSP00470 
CSP00480 
CSP00490 
CSP00500 
CSP00510 
CSP00520 
CSPJ0530 
CSP00540 
CSP00550 
CSP00560 
CSP00570 
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002C 


0070 




STO 




002D 


7002 


SWIT 


MDX 




002E 01 


D480002B 




STO 


I 


0030 01 


4C100037 




BSC 


L 


0032 


F069 




EOR 




0033 01 


D480002B 




STO 


I 


0035 01 


74010041 




MDX 


L 


0037 00 


C4000000 


KPLUS 


LD 


L 


0039 


D064 




STO 




003A 01 


4C100041 




BSC 


L 


003C 


F05F 




EOR 




003D 01 


D4800038 




STO 


I 


003F 01 


74010041 




MDX 


L 



0041 


C062 


OP 


LD 


OPR 


0042 


0017 




STO 


DO 


0043 


C063 




LD 


OPO 


0044 


DOFC 




STO 


OP 


0049 


C104 




LD 


1 4 


0046 


001C 




STO 


Kl 


0047 


003A 




STO 


K2 



0048 


00 


C58000O5 




LD 


11 


004A 





D03B 




STO 




004B 


00 


95800004 




S 


11 


004D 





D021 




STO 




004E 


00 


95800002 




S 


11 


0050 


00 


85800001 




A 


11 


0052 


01 


4C2800A0 




BSC 


L 


0054 





7107 




MDX 


1 


0055 





6928 




STX 


1 


0056 


00 


65000000 


COUNT 


LDX 


LI 


0058 


00 


C5000000 


KCRD3 


LD 


LI 


005A 


00 


85000000 


DO 


A 


LI 


005C 


00 


D5000000 


KCRD4 

* 


STO 


LI 


005E 





71FF 


• 


MDX 


1 


005F 





70F8 


• 


MDX 




0060 


30 


03059668 


AGAIN 


CALL 





JSIGN SAVE SIGN OF JCARD 

•♦2 SKIP ON ADD-CHANGE SIGN ON SUBT 

JPLUS+1 STORE CHANGED SIGN OF JCARD 

KPLUS*- DETERMINE SIGN OF JCARD 

HFFFF NEGATIVE - MAKE POSITIVE 

JPLUS+1 STORE IT POSITIVE 

OP.l CHANGE OPERATION - SEE OP 6 OPR 

*-• GET SIGN OF KCARD " 

KSIGN SAVE SIGN OF KCARD 

0P»- DETERMINE SIGN OF KCARD 

HFFFF NEGATIVE - MAKE POSITIVE 

KPLUS+1 STORE IT POSITIVE 

0P»1 CHANGE OPERATION - SEE OP 6 OPR 
CALCULATE THE OPERATION. 
INITIALLY THIS IS FOR ADD. IT 
CAN BE CHANGED UP TO TWO TIMES i 
FIRST TO SUBTRACT AND THEN BACK 
AGAIN TO ADD* SEE OPR. 
PICK UP OPERATION 
STORE IT AT DO 

RESET THE PICK UP INSTRCTN TO + 
WITH INSTRUCTION AT OPO 
GET ADDRESS OF K 

STORE IT AT Kl FOR CARRY SUBRTN 
AND AT K2 FOR FILL SUBROUTINE 
DETERMINE IF JCARD IS LONGER 
THAN KCARD. KLAST-JLAST+J-KNOW 
IS COMPARED TO K. IF KNOW IS 
GREATER THAN OR EQUAL TO K GO 
TO KLAS3 FOR ERROR. 

5 GET KLAST VALUE 

KLAS3+1 SAVE IT TO INDICATE ERROR 

4 SUBTRACT K VALUE 

COMP+1 SAVE FOR CMPLMNT ON NEG CARRY 

2 SUBTRACT JLAST VALUE 

1 ADD J VALUE 

RETAD»+Z IS JCARD LONGER THAN KCARD 

7 NO-OK-MOVE OVER SEVEN ARGUMENTS 

D0NE1+1 CREATE RETURN ADDRESS 
SETUP JNOW 

*-* LOAD JCARD LENGTH TO IR1 

KCARD (KNOW) -KCARD (KNOW) + OR - 
JCARD (JNOW) 

*-* LOAD KCARD (KNOW) 

•-• ADD OR SUBTRACT JCARD (JNOW) 

*-* STORE RESULT IN KCARD (KNOW) 

KNOW-KNOW+1 AND SEE IF JNOW IS 
GREATER THAN JLAST. IF NOT* 
JNOW-JNOW+1 AND GO BACK FOR 
MORE. 

-1 DECREMENT IR1 

KCRD3 GO BACK FOR MORE 

RESOLVE CARRIES GENERATED 
DURING OPERATION. 

CARRY GO TO CARRY SUBROUTINE 



PAGE 2 

CSP00580 
CSP00590 
CSP00600 
CSP00610 
CSP00620 
CSP00630 
CSP00640 
CSP00650 
CSP00660 
CSP00670 
CSP00680 
CSP00690 
CSP00700 
CSP00710 
CSP00720 
CSP00730 
CSP00740 
CSP00750 
CSP00760 
CSP00770 
CSP00780 
CSP00790 

cspooaoo 

CSP00810 
CSP00820 
CSP00830 
CSP00840 
CSP00850 
CSP00860 
CSP00870 
CSP00880 
CSP00890 
CSP00900 
CSP00910 
CSP00920 
CSP00930 
CSP00940 
CSP00950 
CSP00960 
CSP00970 
CSP00980 
CSP00990 
CSP01000 
CSP01010 
CSP01020 
CSP01030 
CSP01040 
CSP01O5O 
CSP01060 
CSP01070 

cspoioeo 

CSP01090 
CSP01100 
CSP01110 
CSP01120 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 
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ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



0062 


0000 


KCRDl DC 


0063 


0000 


Kl DC 


0064 1 


008? 


KLAS1 DC 


0065 1 


0008 


DC 



0066 


01 


4C18008A 




BSC 


L 


0068 


01 


4C100080 




BSC 


L 


006A 


00 


84000000 


KCRD7 


A 


L 


006C 


01 


D480006B 


* 
ft 
• 
COMP 


STO 


I 


006E 


00 


63000000 


LDX 


LI 


0070 





7101 




vox 




0071 





C02E 




LD 




0072 


00 


95000000 


KCRD5 


S 


LI 


007* 


00 


05000000 


KCRD6 

ft 


STO 


LI 


0076 





71FF 


• 


MDX 


1 


0077 





7CF9 




MDX 




0078 





C026 




LD 




0079 





F0FA 




EOR 




007A 





D024 




STO 




007B 





70E* 




MDX 




007C 


00 


65000000 


SAVE1 


LDX 


LI 


007E 


oc 


4C0OOOOO 


DONE1 

• 
ERR9 


BSC 


L 


0080 


30 


062534C0 


CALL 




0082 





0000 


KCRD2 


DC 




0083 





0000 


<2 


DC 




0084 


1 


0087 


KLAS2 


DC 




008S 


1 


00A0 




DC 




0086 


00 


65000000 


KLAS3 


LDX 


LI 


0086 


00 


■60000000 


ERA 

» 


STX 


LI 


008A 





C013 


• 
FIN 


LD 




008B 


01 


D4S0002B 




STO 


I 


008D 





con 




LD 




008E 


01 


4C280095 




BSC 


L 


0090 


01 


C4800038 




LD 


I 


0092 


01 


4C280099 




BSC 


L 


0094 





70E7 




MDX 




0095 


01 


C4800038 


NEG 


LD 


I 


0097 


01 


4C28007C 




BSC 


L 


0099 





F003 


REV 


EOR 




009A 


01 


D4800038 




STO 


1 


009C 





70DF 




MDX 




0090 





FFFF 


HFFFF 


DC 




009E 





0000 


JSIGN 


OC 





*-• KCARD ADDRESS 

•-* K ADDRESS 

KLAS3+1 KLAST ADDRESS 

ADD ADDRESS TO HOLD ANY CARRY 

LET KNOW BE ANY RESULTING CARRY 
IF NEGATIVE* COMPLIMENT AND 
CHANGE THE SIGN OF KCARD. IF 
ZERO* ALL DONE* IF POSITIVE* 
OVERFLOW ERROR* 

FIN.+- CHECK FOR ZERO-YES GO TO FIN 

ERR9»- NO-CHECK FOR OVERFLOW-YES ERR9 

•-* COMPLIMENT-ADD CARRY TO LOW 

KCRD7+1 ORDER AND STORE IT BACK 
COMPLIMENT - SUBTRACT EACH 
DIGIT FROM 9 AND CHANGE THE 
SIGN OF KCARD. 

*-* LOAD IR1 WITH LENGTH OF KCARD 

1 ADD 1 TO GET THE TRUE LENGTH 

NINE LOAD A NINE* 

*-• SUBTRACT KCARD(KNOW) 

• -« PUT BACK IN KCARD(KNOW) 

SEE IF KNOW IS GREATER THAN 
KLAST* IF NOT* KN0W«KN0W+1 

-1 DECREMENT IR1 

COMP+3 GO BACK FOR MORE 

KSIGN 

KCRD6 

KSIGN SET SIGN OF KCARD 

AGAIN CHECK AGAIN FOR CARRIES 

*-* RESTORE IR1 

*-• RETURN TO CALLING PROGRAM 

ERROR - ERROR - OVERFLOW 

FILL FILL KCARD WITH NINES* 

•-• ADDRESS OF KCARD 

*-* ADDRESS OF K 

KLAS3+1 ADDRESS KLAST 

NINE FILL CHARACTER 

•-* PICK UP KLAST VALUE 

»-• STORE VALUE AT NER 

RESTORE SIGNS ON JCARD AND 
KCARD FIELDS 

JSIGN PICK UP SIGN OF JCARD 

JPLUS+1 AND RESTORE IT 

KSIGN PICK UP SIGN OF KCARD 

NEG*+Z CHECK FOR PLUS OR MINUS 

KPLUS+1 PLUS-GET NEW SIGN AND 

REV.+Z REVERSE IT IF NEGATIVE 

SAVE1 POSITIVE-ALL DONE-GO TO EXIT*. 

ICPLUS+1 MINUS-GET NEW SIGN AND 

SAVE1*+Z GO TO EXIT IF NOT NEGATIVE 

HFFFF REVERSE THE SIGN 

KPLUS+1 STORE IT BACK 

SAVE1 ALL DONE-GO TO EXIT 

/FFFF CONSTANT OF ALL BINARY ONES 

•-• SIGN OF JCARD 



PAGE 3 

CSP01130 
CSP01140 
CSP01150 
CSP01160 
CSP01170 
CSP01180 
CSP0U90 
CSP01200 
CSP01210 
CSP01220 
CSP01230 
CSP01240 
CSP01250 
CSP01260 
CSP01270 
CSP01280 
CSP01290 
CSP01300 
CSP01310 
CSP01320 
CSP01330 
CSP01340 
CSP01350 
CSP01360 
CSP01370 
CSP01380 
CSP01390 
CSP01400 
CSP01410 
CSP01420 
CSP01430 
CSP01440 
CSP01450 
CSP01460 
CSP01470 
CSP01480 
CSP01490 
CSP01500 
CSP01510 
CSP01520 
CSP01530 
CSP01540 
CSP01550 
CSP01560 
CSP01570 
CSP01580 
CSP01590 
CSP01600 
CSP01610 
CSP01620 
CSP01630 
CSP01640 
CSP01650 
CSP01660 
CSP01670 



009F 


0000 


KSIGN 


DC 




00A0 


0009 


NINE 


DC 




00A1 


7107 


RETAD 


MDX 


1 


00A2 


69DC 




STX 


1 


OOA3 01 


4C000086 




BSC 


L 


00A5 00 


85000000 


OPR 


A 


LI 


00A7 






ORG 




00A6 00 


95000000 




S 


LI 


00A8 






ORG 




00A7 00 


85000000 




A 


LI 


00A9 






ORG 




00A8 


C063 


OPO 


LD 


X 



END 



NO ERRORS IN ABOVE ASSEMBLY* 



*-* SIGN OF KCARD 

9 CONSTANT OF NINE 

7 MOVE OVER SEVEN ARGUMENTS 

DONE 1*1 CREATE RETURN ADDRESS 

KLAS3 GO TO KLAS3 

*-* ADD FOR ADD OR SUBTRACT OPERATN 

OPRfl RESET THE ADDRESS COUNTER 

•-• SUBTR FOR ADD OR SUBTR OPRATN 

OPR+2 RESET THE ADDRESS COUNTER 

*■** ADD FOR ADD OR SUBTRACT OPERATN 

OPR+3 RESET THE ADDRESS COUNTER 

OPR-OP-1 FOR RESETING THE INSTRCTN 

AT OP TO ITS INITIAL STATE*. 
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CSP01680 
CSP01690 
CSP01700 
CSP01710 
CSP01720 
CSP01730 
CSP01740 
CSP01750 
CSP01760 
CSP01770 
CSP01780 
CSP01790 
CSP01800 
CSP01810 



// DUP 
•STORE 
341B OOOC 



WS UA ADD 



CSP01820 
CSP01830 
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// ASM 

** A1A3/A3A1 SUBROUTINES FOR 1130 COMMERCIAL SUBROUTINE PACKAGE 

* NAME A1A3 

* LIST 

0000 01C41CC0 ENT 

* CALL 



(ID) 
(ID) 



01CC1C40 



0000 
0001 
0002 
0003 
0004 
0005 
0006 
0007 
0008 
0009 
00 OA 
OOOB 
OOOC 
0000 
OOOE 
0010 
0011 
0013 
0014 
001S 
0016 
0017 
0018 
001A 
00 IB 
0010 
001F 
0020 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0029 
002B 
0020 
002E 
0030 
0031 
0032 
0033 



0000 

C002 

002A 

7007 

7021 

7000 

0000 

COFE 

00F7 

COFB 

0022 

6965 

6A66 

6B67 
01 65800000 
C100 
00 95800002 
0018 
D03F 
0044 
C103 
8006 
00 95800004 
DOOD 
00 C5800002 
00 95800001 
80FE 

D009 

C105 

9028 

D060 

D066 

7106 

6950 
00 65000000 
00 66000000 
00 C6000000 

7000 

01 4C280047 
1890 

A81B 
801B 
0002 



swi 

SW2 
A3A1 



ENT 
CALL 



A1A3 DC 
LD 
STO 
MDX 
MOX 
MDX 
DC 
LD 
STO 
LD 
STO 
START STX 
STX 
STX 
LDX 
LD 
S 

STO 
STO 
STO 
LD 
A 
S 

STO 
LD 
ONE S 
A 

STO 
LD 
S 

STO 
STO 
MDX 
STX 
KCARD LDX 
CNT LDX 
JCARD LD 
SWTCH MDX 
BSC 
SRT 
D 
A 
HOLD STO 



A1A3 A1A3 SUBROUTINE ENTRY POINT 

A1A3UCARD.J.JLAST.KCARD.K.ICHAR) 
THE WORDS JCARD U) THROUGH 
JCARDULAST) IN Al FORMAT ARE 
CRAMMED INTO KCARD IN A3 FORMAT* 
A3A1 A3A1 SUBROUTINE ENTRY POINT 

A3AK JCARD* J. JLAST .KCARD. K.I CHAR) 
THE WORDS JCARD(J) THROUGH 
JCARDULAST) IN A3 FORMAT ARE 
UNCRAMMED INTO KCARD IN Al FORMAT. 
«-• ARGUMENT ADDRESS COMES IN HERE 
SWI LOAD BRANCH TO ELSE 
SWTCH STORE BRANCH AT SWITCH 
START START COMPUTING 

X ELSE-SWTCH-1 BRANCH TO ELSE 

X NOP INSTRUCTION 

»-* ARGUMENT ADDRESS COMES IN HERE 
A3A1 PICK UP ARGUMENT ADDRESS AND 
A1A3 STORE IT IN A1A3 
SW2 LOAD NOP INSTRUCTION 
SWTCH STORE NOP AT SWITCH 

1 SAVE1+1 SAVE IR1 

2 SAVE2+1 SAVE IR2 

3 SAVE3+1 SAVE IR3 

II A1A3 PUT ARGUMENT ADDRESS IN IR1 
1 GET JCARD ADDRESS 

II 2 SUBTRACT JLAST VALUE 

JCARD+1 CREATE JCARD(J) ADDRESS 
0VR1+1 STORE JCARD(J) ADDRESS 
0VR2+1 STORE JCARD(J) ADDRESS 
1 3 GET KCARD ADDRESS 
ONE+1 ADD CONSTANT OF 1 

II 4 SUBTRACT K VALUE 

KCARD+1 CREATE KCARD(K) ADDRESS 

II 2 GET JLAST VALUE 

II 1 SUBTRACT J VALUE 

ONE+i ADD CONSTANT OF 1 
CNT+1 CREATE FIELD WIDTH 
1 5 GET ICHAR ADDRESS 

D40 SUBTRACT CONSTANT OF 40 
TABLE+1 CREATE TABLE END ADDRESS 
TCODE+1 STORE TABLE END ADDRESS 
1 6 ADJUST OVER 6 ARGUMENTS 
1 D0NE1+1 CREATE RETURN ADDRESS 

LI *-* PUT KCARD ADDRESS IN IR1 

L2 •-« PUT FIELD WIDTH IN IR2 

L2 *-* PICK UP JCARD(J) 

X SWITCH BETWEEN CRAM AND UNCM 

L MINUS.+Z TEST SIGN OF INTEGER 
16 SHIFT INTEGER TO EXTENSION 
D1600 DIVIDE BY 1600 
D20 ADJUST FIRST VALUE 
A3A1 SAVE FIRST CHARACTER VALUE 



CSP01S40 
CSP01850 
CSP01860 
CSP0187O 
CSP01880 
CSP01890 
CSP01900 
CSP01910 
CSP01920 
CSP01930 
CSP01940 
CSP01950 
CSP01960 
CSP01970 
CSP01980 
CSP01990 
CSP02000 
CSP02010 
CSP02020 
CSP02030 
CSP02040 
CSP02050 
CSP02060 
CSP02070 
CSP02080 
CSP02090 
CSP02100 
CSP02110 
CSP02120 
CSP02130 
CSP02140 
CSP02150 
CSP02160 
CSP02170 
CSP02180 
CSP02190 
CSP02200 
CSP02210 
CSP02220 
CSP02230 
CSP02240 
CSP02250 
CSP02260 
CSP02270 
CSP02280 
CSP02290 
CSP02300 
CSP02310 
CSP02320 
CSP02330 
CSP02340 
CSP02350 
CSP02360 
CSP02370 
CSP02380 
CSP02390 
CSP02400 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 
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ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



0034 
0035 
0036 
0037 
0038 
003A 
003B 
003C 
003E 
003F 
0040 
0042 
0043 
0044 
0045 
0046 
0047 
0048 
0049 
004A 
0048 
004C 
004D 
004E 
004F 
0050 
0051 
0052 
0053 
0055 
0056 
0057 
0058 
0059 
005B 
005D 
005E 
005F 
0061 
0062 
0063 
0064 
0065 
0066 
0068 
0069 
006A 
0066 
006C 
006D 
006E 
006F 
0070 
0072 
0074 



1810 
A815 
D0C9 

1090 

01 4400007E 
D1FE 

C0C4 

01 4400007E 
D1FF 

C0C6 

01 4400007E 
D100 

71FD 

72FF 

70E5 

7029 

8004 

1890 

A803 

70E8 

0028 

7000 

0640 

0014 

D0B6 

72FF 

7001 

7025 
00 C6000000 
D0AA 
72FF 
7001 
7021 

00 C6000000 

01 44000087 
D0CA 

C0A1 

01 44000087 
A0E9 

1090 
80C4 
00C3 

COAO 

01 44000087 
90E5 

A0E3 

1090 

80BC 

0100 

71FF 

72FF 

70BB 
00 65000000 
00 66000000 
00 67000000 



SRA 
D 

STO 
SLT 
BSI 
STO 
LD 
BSI 
STO 
LD 
BSI 
STO 
MDX 
MDX 
MDX 
MDX 
MINUS A 

SRT 
D 

MDX 
D40 DC 
D32K DC 
D1600 DC 
D20 DC 
ELSE STO 
MDX 
MDX 
MDX 
OVRl LD 
STO 
MDX 
MDX 
MDX 
OVR2 LD 
RET BSI 
STO 
LD 
BSI 
M 

SLT 
A 

STO 
LD 
BSI 
S 
M 

SLT 
A 

STO 

MDX 

MDX 

MDX 

SAVE1 LDX 

SAVE2 LDX 

SAVE3 LDX 



16 ZERO ACCUMULATOR 
D40 DIVIDE BY 40 
A1A3 SAVE SECOND CHARACTER VALUE 
16 SHIFT THIRD CHAR VALUE TO ACCUM 
OECOD DECODE THIRD CHARACTER 
-2 STORE THIRD CHARACTER 
A1A3 GET SECOND CHARACTER 
OECOD DECODE SECOND CHARACTER 
-1 STORE SECOND CHARACTER 
A3A1 GET FIRST CHARACTER 
OECOD DECODE FIRST CHARACTER 
STORE FIRST CHARACTER 
-3 DECREMENT Al OUT ARRAY 
-1 DECREMENT FIELD WIDTH 
JCARD FIELD WIDTH IS NOT ZERO 
SAVE1 GO TO RESTORE AND RETURN 
D32K ADJUST FOR NEGATIVE INTEGER 
16 SHIFT INTEGER TO EXTENSION 
01600 DIVIDE BY 1600 

HOLD GO TO GET THE REMAINING INTEGERS 
40 CONSTANT OF 40 
32000 CONSTANT OF 32000 
1600 CONSTANT OF 1600 
20 CONSTANT OF 20 
A3A1 STORE FIRST Al CHARACTER 
-1 DECREMENT FIELD WIDTH 
OVRl GO TO GET NEXT CHARACTER 
FILL1 LAST CHARACTER-FILL WITH BLANK 
*-* GET SECOND CHARACTER 
A1A3 STORE SECOND CHARACTER 
-1 DECREMENT FIELD WIDTH 
0VR2 GO TO GET NEXT CHARACTER 
FILL2 LAST CHARACTER-FILL BLANK 
«-* GET THIRD CHARACTER 
CODE CODE CHARACTER TO NUMBER 
KCARD61 SAVE NUMBR OF THIRD CHARACTER 
A1A3 GET SECOND CHARACTER 
CODE CODE SECOND CHARACTER 
D40 MULTIPLY BY 40 AND 
16 SHIFT TO ACCUMULATOR 
KCARD+1 ADD NUMBERC THIRD) AND 
KCARD+1 SAVE RESULTING INTEGER 
A3A1 GET FIRST CHARACTER 
CODE CODE FIRST CHARACTER 
D20 SUBTRACT 20 
D1600 MULTIPLY BY 1600 
16 SHIFT TO ACCUMULATOR 
KCARD+1 ADD IN PREVIOUS RESULT 
STORE IN A3 ARRAY 
-1 NEXT WORD IN A3 ARRAY 
-1 DECREMENT FIELD WIDTH 
JCARD GET MORE Al CHARACTERS 
LI *-« RESTORE IR1 
RESTORE IR2 



L2 



L2 



L3 «-* RESTORE IR3 
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CSP02410 
CSP02420 
CSP02430 
CSP02440 
CSP02450 
CSP02460 
CSP02470 
CSP02480 
CSP02490 
CSP02S00 
CSP02510 
CSP02520 
CSP02530 
CSP02540 
CSP02550 
CSP02560 
CSP02570 
CSP02580 
CSP02590 
CSP02600 
CSP02610 
CSP02620 
CSP02630 
CSP02640 
CSP02650 
CSP02660 
CSP02670 
CSP02680 
CSP02690 
CSP02700 
CSP02710 
CSP02720 
CSP02730 
CSP02740 
CSP02750 
CSP02760 
CSP02770 
CSP02780 
CSP02790 
CSP02800 
CSP02810 
CSP02820 
CSP02830 
CSP02840 
CSP02850 
CSP02660 
CSP02870 
CSP02880 
CSP02890 
CSP02900 
CSP02910 
CSP02920 
CSP02930 
CSP02940 
CSP02950 



0076 


00 


4C0O0000 


D0NE1 


BSC 


L 


0078 





C004 


FILL1 


LD 




0079 





D086 




STO 




007A 





C002 


FILL2 


LD 




007B 





7201 




MDX 


2 


007C 





70DE 




MDX 




007D 





4040 


H4040 


DC 




007E 





0000 


DECOD 


DC 




007F 





809E 




A 




0080 





D001 




STO 




0081 


00 


67000000 


PLACE 


LDX 


L3 


0083 


00 


C7000000 


TABLE 


LD 


L3 


0085 


01 


4C80007E 




BSC 


I 


0087 





0000 


CODE 


DC 




0088 





D0F5 




STO 




0089 





6328 




LDX 


3 


008A 


00 


C7000000 


TCODE 


LD 


L3 


008C 





F0F1 




EOR 




008D 


01 


4C200094 




BSC 


L 


008F 





6BEE 


AWAY 


STX 


3 


0090 





COED 




LD 




0091 





908C 




S 




0092 


01 


4C800087 




BSC 


I 


0094 





73FF 


OUT 


MDX 


3 


0093 





70F4 




MDX 




0096 





C0E6 




LD 




0097 





70F0 




MDX 




0098 








END 





*-« RETURN TO CALLING PROGRAM 

H4040 FILL WITH TWO BLANKS 

A1A3 STORE SECOND CHARACTER BLANK 

H4040 FILL WITH ONE BLANK 

1 SET IR1 TO 1 

RET GO TO CODE ROUTINE 

/4040 CONSTANT OF Al BLANK 

*-* DECODE RETURN ADDRESS GOES HERE 

ONE+1 ADD ONE TO NUMBER GIVING 

PLACE+1 SUBSCRIPT OF TABLE AND SAVE 

*-* LOAD IRS WITH SUBSCRIPT OF TABLE 

«-* GET Al CHARACTER 

DECOD RETURN 

*-* CODE RETURN ADDRESS GOES HERE 

DECOD SAVE THE CHARACTER TO BE CODED 

40 LOAD IR3 WITH THE TABLE LENGTH-40 

*-« LOAD CHARACTER FROM I CHAR ARRAY 

DECOD ZERO ACCUMULATOR IF MATCH 

OUT.Z GO TO PUT IF NOT ZERO 

DECOD SAVE SUBSCRIPT OF MATCH 

DECOD LOAD SUBSCRIPT 

ONE+1 SUBTRACT ONE GIVING NUMBER 

CODE RETURN 

-1 DECREMENT THROUGH THE TABLE-ICHAR 

TCODE GO TRY AGAIN 

H4040 NOT IN THE TABLE - LOAD A BLANK 

CODE+1 GO BACK TO CODE THE BLANK.... 
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CSP02960 
CSP02970 
CSP02980 
CSP02990 
CSP03000 
CSP03010 
CSP03020 
CSP03030 
CSP03040 
CSP03050 
CSP03060 
CSP03070 
CSP03080 
CSP03090 
CSP03100 
CSP03110 
CSP03120 
CSP03130 
CSP03140 
CSP03150 
CSP03160 
CSP03170 
CSP03180 
CSP03190 
CSP03200 
CSP03210 
CSP03220 
CSP03230 



NO ERRORS IN ABOVE ASSEMBLY. 



// DUP 
•STORE 
3332 OOOA 



WS UA A1A3 



CSP03240 
CSP03250 
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// ASM 

«» A1DEC SUBROUTINE FOR 1130 COMMERCIAL SUBROUTINE PACKAGE 

« NAME A10EC 

* LIST 

0001 01C44143 ENT 



(ID) 
(ID) 



0000 


0004 


FOUR 


DC 




0001 


0000 


A1DEC 


DC 




0002 


6941 




STX 


1 


0003 01 


65800001 




LDX 


11 


0005 


C100 




LD 


1 


0006 


0017 




STO 




0007 00 


95800002 


TWO 


S 


U 


0009 


D01B 




STO 




OOOA 


D02C 




STO 




OOOB 


8007 




A 




OOOC 


0033 




STO 




OOOD 


C102 




LD 


1 


OOOE 


0010 




STO 




OOOF 01 


C480001F 




LD 


I 


0011 


OOEF 




STO 




0012 00 


95800001 


ONE 


S 


11 


0014 


80FE 




A 




0015 


4808 




BSC 




0016 


COFC 




LD 




0017 


OOOB 




STO 




ooie o 


C103 




LD 


1 


0019 


D016 




STO 




001A 


7104 




MDX 


1 


001B 


692A 


» 


STX 


1 


001C 30 


15A56545 


CALL 




OOIE 


0000 


JCRD1 


DC 




001F 


0000 


JLAS1 


DC 




0020 1 


0000 




DC 




0021 1 


OOIE 




DC 




0022 00 


65000000 


COUNT 

* 

PICK 


LDX 


LI 


0024 00 


C5000000 


LD 


LI 


0026 01 


4C100032 




BSC 


L 


0028 


901E 




S 




0029 01 


4C100035 


ERR 


BSC 


L 


002B 


69F7 


STX 


1 


002C 


C0D4 




LD 




002D 


90F5 




S 




002E 


80E4 




A 




002F 00 


04000000 


ERA 


STO 


L 


0031 


7006 




MDX 




0032 


9015 


POS 


S 




0033 01 


4C20002B 




BSC 


L 



0035 1808 

0036 00 D5000000 



0038 

0039 



71FF 
70EA 



OK 

PUT 



SRA 
STO 



MORE MDX 
MDX 



003A 


C0E3 




LD 




003B 


90CC 




S 




003C 01 


4C200043 




BSC 


L 


003E 


90D4 




S 




003F 00 


F4000000 


LAST 


EOR 


L 


0041 01 


04800040 




STO 


I 


0043 00 


65000000 


SAVE1 


LDX 


LI 


0045 00 


4C0OOOOO 


D0NE1 


BSC 


L 


0047 


F040 


ZERO 


DC 




0048 


4040 


BLANK 


DC 




004A 






END 





A1DEC A1DEC SUBROUTINE ENTRY POINT 
CALL A1DECUCARD.J.JLAST.NER) 
THE WORDS JCARD(J) THROUGH 
JCARDC JLAST) ARE CONVERTED FROM 
Al FORMAT TO Dl FORMAT AND THE 
ORIGINAL DATA IS REPLACED BY THE 
CONVERTED DATA. 

4 CONSTANT OF FOUR 

»-• ARGUMENT ADDRESS COMES IN HERE 

SAVE1+1 SAVE IR1 

A1DEC PUT ARGUMENT ADDRESS IN IR1 

GET JCARD ADDRESS 

JCRD1 SETUP JCARD ADDRESS FOR NZONE 

2 SUBTRACT JLAST VALUE 

PICK+1 PLACE LOAD ADDRESS FOR CONVRS 

PUT+1 PLACE STORE ADDRESS FOR CONVRS 

ONE+1 ADD CONSTANT OF ONE 

LAST+1 PLACE ADDRESS OF SIGN POSITON 

2 GET JLAST ADDRESS 

JLAS1 SETUP JLAST ADDRESS FOR NZONE 
JLAS1 GET JLAST VALUE AND 
A1DEC SAVE IT AT A1DEC 

1 SUBTRACT J VALUE 
ONE+1 ADD CONSTANT OF ONE 
+ CHECK FIELD WIDTH 

ONE+1 ZERO OR NEGATIVE-MAKE IT ONE 
COUNT+1 OK-SAVE WIDTH IN COUNT 

3 GET NER ADDRESS 
ERA+1 SAVE IT 

4 MOVE OVER FOUR ARGUMENTS 
D0NE1+1 CREATE RETURN ADDRESS 

REMOVE AND SAVE THE SIGN 
NZONE REMOVE THE ZONE OVER LOW ORDER 
«-* ADDRESS OF JCARD 
«-* ADDRESS OF JLAST 
FOUR ADDRESS OF CONSTANT OF FOUR 
JCRD1 ADDRESS OF OLD ZONE 

JNOW-J 
*-» LOAD IR1 WITH FIELD WIDTH 

JTEST-JCARD(JNOW) 
*-« PICK UP JCARD(JNOW) AND 
POS.- CHECK IT AGAINST ZERO 
ZERO NEGATIVE-IS IT LESS THAN 
OK.- AN EBCDIC ZERO 

NER-JNOW 
COUNT+1 YES - ERROR 
A1DEC COMPUTE THE SUBSCRIPT 
COUNT+1 OF THIS CHARACTER IN 
ONE+1 THE ARRAY AND 
»-* STORE THE SUBSCRIPT AT NER 
MORE GO GET THE NEXT CHARACTER 
BLANK NOT NEGATIVE - IS IT AN 
ERR.Z EBCDIC BLANK 



CSP03260 
CSP03270 
CSP03280 
CSP03290 
CSP03300 
CSP03310 
CSP03320 
CSP03330 
CSP03340 
CSP03350 
CSP03360 
CSP03370 
CSP03380 
CSP03390 
CSP03400 
CSP03410 
CSP03420 
CSP03430 
CSP03440 
CSP03450 
CSP03460 
CSP03470 
CSP03480 
CSP03490 
CSP03500 
CSP03510 
CSP03520 
CSP03530 
CSP03540 
CSP03550 
CSP03560 
CSP03570 
CSP03580 
CSP03590 
CSP03600 
CSP03610 
CSP03620 
CSP03630 
CSP03640 
CSP03650 
CSP03660 
CSP03670 
CSP03680 
CSP03690 
CSP03700 
CSP03710 
CSP03720 
CSP03730 
CSP03740 
CSP03750 
CSP03760 
CSP03770 
CSP03780 
CSP03790 
CSP03800 
CSP03810 
CSP03820 



JTEST + 4032 IS NOW IN ACCUM 
SHIFT 8 IS SAME AS DIVIDE BY 256 
8 EITHER BLANK OR DIGIT - PUT 
*-* THE FOUR BITS OF DECIMAL BACK 

SEE IF JNOW IS LESS THAN JLAST* 
IF YES» JNOW-JNOW+1 AND GO BACK 
FOR MORE. IF NO. SET UP THE 
SIGN. 
-1 DECREMENT THE FIELD WIDTH 
PICK GO BACK FOR MORE 

WAS THE ORIGINAL SIGN INDICATION 
TWO. IF NOT. ALL DONE. IF YES 
MAKE THE SIGN NEGATIVE. 
JCAROULAST)— JCARDCJLAST) - 1 
JCRD1 PICK UP THE OLD ZONE AND 
TWO+1 CHECK IT AGAINST TWO 
SAVE1.Z IF NO MATCH GO TO EXIT 
ONE+1 IF MATCH. MAKE THE 
*-« SIGN NEGATIVEtLOW ORDER) AND 
LAST+1 STORE IT BACK 

EXIT 

*-* RESTORE IR1 
*-* RETURN TO CALLING PROGRAM 
/F040 CONSTANT OF EBCDIC ZERO 
/4040 CONSTANT OF EBCDIC BLANK 
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CSP03830 
CSP03840 
CSP03850 
CSP03860 
CSP03870 
CSP03880 
CSP03890 
CSP03900 
CSP03910 
CSP03920 
CSP03930 
CSP03940 
CSP03950 
CSP03960 
CSP03970 
CSP03980 
CSP03990 
CSP04000 
CSP04010 
CSP04020 
CSP04030 
CSP04040 
CSP04050 
CSP04060 
CSP04070 
CSP04080 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



NO ERRORS IN ABOVE ASSEMBLY. 



// DUP 
*STORE 
333C 0005 



WS UA A1DEC 



CSP04090 
CSP04100 
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ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



// ASM 

«» CARRY SUBROUTINE 

* NAME CARRY 

» LIST 

0000 03059668 



FOR 1130 COMMERCIAL SUBROUTINE PACKAGE 



(ID) 
(10) 



0000 





0000 


CARRY 


DC 




0001 





6930 




STX 


1 


0002 


01 


65800000 




LDX 


11 


000* 





C100 




LO 


1 


0005 


00 


95800002 




S 


11 


0007 





8004 




A 




0008 





0011 




STO 




0009 


00 


C5800002 




LD 


11 


000B 


00 


95800001 


ONE 


S 


11 


0000 





80FE 




A 




000E 





4808 




BSC 




000F 





C0FC 




LD 




0010 





D007 




STO 




0011 





C103 




LD 


1 


0012 





D01D 




STO 




0013 





7104 




MDX 


1 


0014 





691F 




STX 


1 


0015 





10A0 




SLT 




0016 





D0E9 




STO 




0017 


00 


65000000 


COUNT 


LDX 


LI 



0019 00 


C4000000 


SRCE 


LD 


001B 


80E4 




A 


001C 


1890 




SRT 


001D 


A817 




D 


001E 


D0E1 


* 


STO 


001F 


1090 


» 


SLT 


0020 01 


4C100028 




BSC 


0022 


8012 




A 


0023 


1890 




SRT 


0024 


CODB 




LD 


0025 


90E6 




S 


0026 


D0D9 




STO 



CARRY CARRY SUBROUTINE ENTRY POINT 

CALL CARRY(JCARD.J.JLAST»KARRY) 
THE WORDS JCARD(J) THROUGH 
JCARDCJLAST) ARE CHECKED TO SEE 
THAT THEY ARE BETWEEN ZERO AND 
NINE. IF THEY ARE NOT* THE 
UNITS DIGIT REMAINS AND THE TENS 
DIGIT IS TREATED AS A CARRY TO 
THE NEXT WORD. 

#-* ARGUMENT ADDRESS COMES IN HERE 

SAVE1+1 SAVE IR1 
II CARRY PUT ARGUMENT ADDRESS IN IR1 

GET JCARD ADDRESS 
2 SUBTRACT JLAST VALUE 
ONE+1 ADD CONSTANT OF ONE 
SRCE+1 CREATE JCARD(JLAST) ADDRESS 

2 GET JLAST VALUE 

1 SUBTRACT J VALUE 
ONE+1 ADD CONSTANT OF ONE 
+ CHECK FIELD WIDTH 
ONE+1 ZERO OR NEGATIVE-MAKE IT ONE 
COUNT+1 OK-SAVE WIDTH IN COUNT 

3 GET KARRY ADDRESS 
OVF+1 AND SAVE IT 

4 MOVE OVER FOUR ARGUMENTS 
DONE1+1 CREATE RETURN ADDRESS 
32 CLEAR THE ACCUMULATOR AND EXTEN 

LET CARRY BE THE SAME AS NCARY 

CARRY SET NCARY TO ZERO 

«-«■ LOAD IR1 WITH THE FIELD WIDTH 

THE NEXT INSTRUCTION STARTS OUT 
BY PICKING UP JCARD< JLAST*. 
THE SUBSCRIPT IS DECREMENTED BY 
THE INSTRUCTION AFTER POSZ. 
THE CALCULATIONS ARE.. 
JTEST" JCARD < JNOW )+NCARY 
NCARY-JTEST/10 
JTEST«JTEST-10#NCARY 

*-* PICK UP JCARDUNOW) 

CARRY ADD THE PREVIOUS CARRY TO IT 

16 SHIFT THE ACCUM TO THE EXTENTON 

TEN DIVIDE BY TEN AND 

CARRY STORE THE QUOTIENT AT NCARY 
THE QUOTIENT IS THE GENERATED 
CARRY. 

16 PUT REMAINDER IN ACCUMULATOR AN 

POSZ.- CHECK TO SEE IF NEGATIVE-NO- 
GO TO POSZ 

TEN YES - COMPLIMENT BY ADDING TEN 

16 STORE TEMPORARILY IN EXTENTION 

CARRY LOAD NCARY 

ONE+1 AND SUBTRACT 

CARRY ONE FROM IT 



0027 





1090 


« 
POSZ 


SLT 




0028 


01 


D480001A 


STO 


I 


002A 


01 


7401001A 


MDX 


L 


002C 
002D 






71FF 
70EB 


* 

# 
OVF 


MDX 
MDX 


1 


002E 
002F 



00 


C0D1 
04000000 


LD 
STO 


L 


0031 
0033 
0035 
0036 


00 
00 



65000000 
4C0000OO 
OOOA 


SAVE1 
DONE1 
TEN 


LDX 
BSC 
DC 
END 


LI 

L 



JCARDC JNOW) -JTEST 
16 SHIFT COMPLIMENTED REMAINDER 

BACK TO ACCUMULATOR 
SRCE+1 AND STORE IN RESULT 

JNOW-JNOW-1 
SRCE+1.1 GO TO NEXT DIGIT OF JCARD 

IF JNOW IS LESS THAN J. ALL 

DONE. OTHERWISE. GET THE NEXT 

DIGIT. 
-1 DECREMENT THE FIELD WIDTH 
SRCE GO BACK FOR NEXT DIGIT 

KARRY-NCARY 
CARRY ALL DONE - PICK UP ANY 
«-* GENERATED CARRY AND STORE IT 

AR KARRY. EXIT.... 

«-» RESTORE IR1 

»-* RETURN TO CALLING PROGRAM 

10 CONSTANT OF TEN 



CSP04110 
CSP04120 
CSP04130 
CSP04140 
CSP04150 
CSP04160 
CSP04170 
CSP04180 
CSP04190 
CSP04200 
CSP04210 
CSP04220 
CSP04230 
CSP04240 
CSP04250 
CSP04260 
CSPQ4270 
CSP0428O 
CSP04290 
CSP04300 
CSP04310 
CSP04320 
CSP04330 
CSP04340 
CSP04350 
CSP04360 
CSP04370 
CSP04380 
CSP04390 
CSP04400 
CSP04410 
CSP04420 
CSP04430 
CSP04440 
CSP04450 
CSP04460 
CSP04470 
CSP04490 
CSP04490 
CSP04500 
CSP04510 
CSP04520 
CSP04530 
CSP04540 
CSP04550 
CSP04560 
CSP04570 
CSP04580 
CSP04590 
CSP04600 
CSP04610 
CSP04620 
CSP04630 
CSP04640 
CSP04650 
CSP0466C 
CSP04670 
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CSP04680 
CSP04690 
CSP04700 
CSP04710 
CSP04720 
CSP04730 
CSP04740 
CSP04750 
CSP04760 
CSP04770 
CSP047B0 
CSP04790 
CSP04800 
CSP04810 
CSP04820 
CSP04830 
CSP04840 
CSP04850 
CSP04860 



NO ERRORS IN ABOVE ASSEMBLYi 



// DUP 
•STORE 
3341 0004 



WS UA CARRY 



CSP04870 
CSP04880 



■158- 



// ASM 

*» DECA1 SUBROUTINE FOR 1130 COMMERCIAL SUBROUTINE PACKAGE 

» NAME DECA1 

• LIST 

0000 0*143071 ENT 



(10) 
(10) 



0000 


0000 


DECA1 


DC 




0001 


6942 




STX 


1 


0002 01 


65800000 




LDX 


11 


0004 


C100 




LD 


1 


0005 


0039 




STO 




0006 00 


95800002 


TWO 


S 


11 


0008 


0020 




STO 




0009 


0030 




STO 




00 OA 


8007 




A 




OOOB 


0010 




STO 




OOOC 


C102 




LD 


1 


0000 


D032 




STO 




OOOE 01 


C4800040 




LD 


I 


0010 


DOEF 




STO 




0011 00 


95800001 


ONE 


S 


11 


0013 


80FE 




A 




0014 


4808 




BSC 




0015 


COFC 




LD 




0016 


0010 




STO 




0017 


C103 




LD 


1 


0018 


D018 




STO 




0019 


7104 




MDX 


1 


001A 


692B 




STX 


1 



001B 00 
0010 01 
001F 

0020 

0021 

0022 01 

0024 

0025 



C4000000 

4C280021 

C027 

7004 

F026 

D480001C 

C0E2 

O0F6 



TEST LD 
BSC 
LD 
MDX 

NEG EOR 
STO 
LD 

GO STO 



0026 00 65000000 COUNT LDX LI *-* 



0028 00 C5000000 
002A 01 4C100033 



002C 
002D 
002E 
002F 



69FA 
C002 
90FB 
80E2 



0030 00 04000000 



PICK LD 
BSC 

» 

ERR STX 
LD 
S 
A 
STO 



ERA 



0ECA1 DECA1 SUBROUTINE ENTRY POINT 
CALL DECAKJCARD*J*JLAST*NER) 
THE WORDS JCARD(J) THROUGH 
JCARDULAST) ARE CONVERTED FROM 
01 FORMAT TO Al FORMAT AND THE 
ORIGINAL OATA IS REPLACED BY THE 
CONVERTED DATA* 

#-* ARGUMENT ADDRESS COMES IN HERE 

SAVE1+1 SAVE IR1 
II DECA1 PUT ARGUMENT ADDRESS IN IR1 

GET JCARD ADDRESS 
JCRD1 SETUP JCARD ADDRESS FOR N20NE 
2 SUBTRACT JLAST VALUE 
PICK+1 PLACE LOAD ADDRESS FOR CONVRSN 
PUT+1 PLACE STORE ADDRESS FOR CONVRSN 
ONE+1 ADD CONSTANT OF ONE 
TEST+1 CREATE JCARDt JLAST) ADDRESS 

2 GET JLAST ADDRESS 
JLAS1 SETUP JLAST ADDRESS FOR NZONE 
JLAS1 GET JLAST VALUE AND 
DECA1 SAVE IT AT DECA1 

1 SUBTRACT J VALUE 
ONE+1 ADD CONSTANT OF ONE 
+ CHECK FIELD WIDTH 
ONE+1 NEGATIVE OR ZERO-MAKE IT ONE 
COUNT+1 OK-SAVE WIDTH IN COUNT 

3 GET NER ADDRESS 
ERA+1 SAVE IT 

4 MOVE OVER FOUR ARGUMENTS 
DONEl+i CREATE RETURN ADDRESS 

CHECK THE SIGN OF JCARD. IF 

NEGATIVE i SET JSIGN»2» AND MAKE 

IT POSITIVE* OTHERWISE* SET 

JSIGN-4 
*-* GET JCARDULAST) 
NEG.+Z CHECK FOR NEGATIVE 
FOUR NO - LOAD FOUR 
GO SKIP OVER NEGATIVE PROCESSING 
HFFFF YES - CHANGE SIGN TO POSITIVE 
TEST+1 RESTORE SIGN AS POSITIVE 
TWO+1 LOAD TWO 
TEST+1 STORE ACCUMULATOR TO SAVE SIGN 

JNOW-J 

LOAD IR1 WITH FIELD WIDTH 

JTEST-JCARD(JNOW) 
LI «-* PICK UP JCARD(JNOW) 
L 0K»- AND CHECK IT AGAINST ZERO 

NER-JNOW 
1 COUNT+1 LESS THAN - ERROR 
DECA1 CALCULATE THE SUBSCRIPT 
COUNT+1 OF THIS DIGIT 
ONE+1 AND STORE 
L *-« IT AT NER 



0032 


7008 




MDX 


0033 


9015 


OK 


S 


0034 01 


4C10002C 


* 


BSC 


0036 


8012 


A 


0037 


1008 




SLA 


0038 


E811 




OR 


0039 00 


05000000 


PUT 

• 
* 
* 
MORE 


STO 


003B 


71FF 


MDX 


003C 


70EB 




MDX 


003D 30 


15A56545 




CALL 


003F 


0000 


JCRD1 


DC 


0040 


0000 


JLAS1 


DC 


0041 1 


001C 




DC 



0042 1 003F 



DC 



0043 00 


65000000 


SAVE1 


LDX 


LI 


0045 00 


4C0OOO00 


D0NE1 


BSC 


L 


0047 


0004 


FOUR 


DC 




0048 


FFFF 


HFFFF 


DC 




0049 


OOOA 


TEN 


DC 




004A 


F040 


ZERO 


DC 




004C 






END 





CSP04890 
CSP04900 
CSP04910 
CSP04920 
CSP04930 
CSP04940 
CSP04950 
CSP04960 
CSP04970 
CSP04980 
CSP04990 
CSP05000 
CSP05010 
CSP05020 
CSP05030 
CSP05040 
CSP05050 
CSP05060 
CSP05070 
CSP05080 
CSP05090 
CSP05100 
CSP05110 
CSP05120 
CSP05130 
CSP05140 
CSP05150 
CSP05160 
CSP05170 
CSP05180 
CSP05190 
CSP05200 
CSP05210 
CSP05220 
CSP05230 
CSP052*0 
CSP05250 
CSP05260 
CSP05270 
CSP05280 
CSP05290 
CSP05300 
CSP05310 
CSP05320 
CSP05330 
CSP05340 
CSP05350 
CSP05360 
CSP05370 
CSP05380 
CSP05390 
CSP05400 
CSP05410 
CSP05420 
CSP05430 
CSP05440 
CSP05450 



1 -1 



MORE GET NEXT DIGIT 

TEN NOT LESS - COMPARE IT TO 

ERR*- CONSTANT OF TEN-NOT LESS GO TO 
ERR 

TEN LESS - ADD TEN BACK 

8 SHIFT THE FOUR BITS OF DECIMAL 

ZERO IN PLACE AND CREATE Al 

*-» CHARACTER-STORE IN JCARD (JNOW) 
SEE IF JNOW IS LESS THAN JLAST* 
IF YES* JNOW'JNOW+1 AND GO BACK 
FOR MORE. IF NO* SETUP THE SIGN 
DECREMENT THE FIELD WIDTH 

PICK GO BACK FOR MORE 

NZONE NZONE ROUTINE TO PLACE SIGN 

*-* ADDRESS OF JCARD 

*-* ADDRESS OF JLAST 

TEST+1 ADDRESS OF SIGN INDICATOR TO 
USE 

JCRD1 ADDRESS OF SIGN INDICATOR FOR 
OLD SI-GN 
EXIT 

*-« RESTORE IRl 

*-* RETURN TO CALLING PROGRAM 

4 CONSTANT OF FOUR 

/FFFF CONSTANT OF ALL BINARY ONES 

10 CONSTANT OF TEN 

/F040 CONSTANT OF EBCDIC ZERO 
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CSP05460 
CSP05470 
CSP05480 
CSP05490 
CSP05500 
CSP05510 
CSP05520 
CSP05530 
CSP05540 
CSP05550 
CSP05560 
CSP05570 
CSP05580 
CSP05590 
CSP05600 
CSP05610 
CSP0562O 
CSP05630 
CSP05640 
CSP05650 
CSP05660 
CSP05670 
CSP05680 
CSP05690 
CSP05700 
CSP05710 
CSP05720 
CSP05730 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



NO ERRORS IN ABOVE ASSEMBLY. 



// DUP 
♦STORE 
3345 0006 



WS UA DECA1 



CSP05740 
CSP05750 



159- 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



// ASM 

** DIV SUBROUTINE 

# NAME DIV 

* LIST 

0000 04265000 



FOR 1130 COMMERCIAL SUBROUTINE PACKAGE 



(ID) 
(ID) 



ENT 



0000 





0000 


DIV 


DC 




0001 





6970 




STX 


1 


0002 





6A71 




STX 


2 


0003 





6B72 




STX 


3 


0004 


01 


65600000 




LDX 


11 


0006 





C100 




LD 


1 


0007 


00 


95800002 




S 


11 


0009 





D04C 




STO 




000A 


01 


D40000AD 




STO 


L 


oooc 





8004 




A 




000D 





D011 


* 
TWO 


STO 




000E 


00 


C5800002 


LD 


11 


0010 


00 


95800001 


ONE 


S 


11 


0012 





80FE 




A 




0013 





4808 




BSC 




0014 





COFC 




LD 




0015 





D03E 




STO 




0016 





C103 




LD 


1 


0017 





D037 




STO 




ooie 


00 


95800005 




S 


11 


001A 





80F6 




A 




001B 





DOOD 




STO 




001C 





7107 




MDX 


1 


001D 





695A 


• 


STX 


1 


001E 


00 


C4000000 


* 
SGNJ 


LD 


L 


0020 





DODF 




STO 




0021 


01 


4C100027 




BSC 


L 


0023 





F039 




EOR 




0024 


01 


D480001F 




STO 


I 


0026 





C036 




LD 




0027 





1890 


JPLUS 


SRT 




0028 


00 


C4000000 


SGNK 


LD 


L 


002A 





D04F 




STO 




002B 


01 


4C100033 




BSC 


L 


002D 





F02F 




EOR 




002E 


01 


04800029 




STO 


I 


0030 





1090 




SLT 




0031 





F02B 




EOR 




0032 





7001 




MDX 




0033 





1090 


KPLUS 


SLT 




0034 





D046 


OVRK 


STO 





DIV DIVIDE SUBROUTINE ENTRY POINT 
CALL DIV (JCARD. J t JLAST. KCARD»K*KLAST.NER> 
THE WORDS JCARD(J) THROUGH 
JCARD(JLAST) ARE DIVIDED INTO 
THE WORDS KCARD(K) THROUGH 
KCARD(KLAST). THE KCARD FIELD 
IS EXTENDED TO THE LEFT AND 
CONTAINS THE QUOTIENT AND 
REMAINDER. 

»-* ARGUMENT ADDRESS COMES IN HERE 

SAVEl+i SAVE IR1 

SAVE2+1 SAVE IR2 

SAVE3+1 SAVE IR3 

DIV PUT ARGUMENT ADDRESS IN IR1 

GET JCARD ADDRESS 
2 SUBTRACT JLAST VALUE 
SRCH+1 STORE END OF JCARD ADDRESS 
MULT1+1 FOR SEARCH AND MULTIPLICATION 
0NE+1 ADD CONSTANT OF ONE 
SGNJ+1 CREATE JCARDJ JLAST) ADDRESS 

JSPAN«JLAST-J+1 

2 GET JLAST VALUE 

1 SUBTRACT J VALUE 
0NE+1 ADD CONSTANT OF ONE 
+ CHECK FIELD WIDTH 
0NE+1 NEGATIVE OR ZERO-MAKE IT ONE 
SRCHT+1 STORE COUNT FOR SEARCH 

3 GET KCARD ADDRESS 
KCRD1 SAVE FOR FILL 
5 SUBTRACT KLAST ■ VALUE 
0NE&1 ADD CONSTANT OF ONE 
SGNK+1 CREATE KCARD(KLAST) ADDRESS 
7 MOVE OVER SEVEN ARGUMENTS 
DONE1+1 CREATE RETURN ADDRESS 

CLEAR AND SAVE THE SIGNS ON THE 
JCARD AND THE KCARD FIELDS 
*-* PICKUP THE SIGN OF JCARD 
DIV SAVE IT IN DIV 

JPLUS*- IF NOT NEGATIVE-GO TO JPLUS 
HFFFF+1 NEGATIVE-MAKE IT POSITIVE 
SGNJ+1 PUT BACK IN JCARD(JLAST) 
HFFFF+1 LOAD A MINUS ONE 
16 SAVE IN EXTENSION 
«-* PICKUP THE SIGN OF KCARD 
KSIGN SAVE IT IN KSIGN 
KPLUS.- IF NOT NEGATIVE-GO TO KPLUS 
HFFFF+1 NEGATIVE-MAKE IT POSITIVE 
SGNK+1 PUT BACK IN KCARD(KLAST) 
16 GET SIGN OF JCARD 
HFFFF+1 CHANGE IT 
OVRK SKIP NEXT INSTRUCTION 
16 GET SIGN OF JCARD 
QSIGN STORE FOR SIGN OF QUOTIENT 



CSP05760 
CSP05770 
CSP05780 
CSP05790 
CSP05800 
CSP05810 
CSP05B20 
CSP09830 
CSP05840 
CSP05850 
CSP05860 
CSP05870 
CSP05880 
CSP05890 
CSP05900 
CSP05910 
CSP05920 
CSP05930 
CSP05940 
CSP05950 
CSP05960 
CSP05970 
CSP05980 
CSP05990 
CSP06000 
CSP06010 
CSP06020 
CSP06030 
CSP06040 
CSP06050 
CSP06060 
CSP06070 
CSP06080 
CSP06090 
CSP06100 
CSP06110 
CSP06120 
CSP06130 
CSP06140 
CSP06150 
CSP06160 
CSP06170 
CSP06180 
CSP06190 
CSP06200 
CSP06210 
CSP06220 
CSP06230 
CSP06240 
CSP06250 
CSP06260 
CSP06270 
CSP06280 
CSP06290 
CSP06300 
CSP06310 
CSP06320 



-160- 



0035 00 C580FFFD 

0037 8025 

0038 0040 

0039 8007 
003A 9019 
003B D041 
003C 00 C580FFFE 
003E 0040 



003F C00F 

0040 903E 

0041 8012 

0042 80CE 

0043 01 D40000DF 

0045 C039 

0046 9032 

0047 900C 

0048 01 4C28005B 

004A C032 

004B 01 4C08005B 



0040 30 062534C0 
004F 0000 

0050 1 007D 

0051 1 0079 

0052 1 007C 

0053 00 66000000 
0055 00 C6000000 

0057 01 4C300080 



SRCHT 
SRCH 



ID 

A 

STO 

A 

S 

STO 

LD 

STO 



LD 

S 

A 

A 

STO 

LD 
S 

s 

BSC 

LD 
BSC 



CALL 

DC 

DC 

DC 

DC 

LDX 
LD 

BSC 



0059 
005A 



72FF 
70FA 



005B C023 
005C 00 D580FFFF 

005E C0A1 
005F 01 D480001F 

0061 C018 

0062 01 4C28006C 
0064 01 C4800029 
0066 01 4C100071 

0068 F0F4 

0069 01 D4800029 



ERR 
HFFFF 



MDX 
MDX 

LD 

STO 

LD 
STO 

LD 

BSC 

LD 

BSC 

EOR 

STO 



KSTRT-K-1 
II -3 GET VALUE OF K 

HFFFF&l SUBTRACT CONSTANT OF ONE 
KSTRT SAVE IN KSTRT 

KLOWK-JSPAN 
ONE+1 GET VALUE OF K 
SRCHT+1 SUBTRACT JSPAN 
KLOW SAVE IN KLOW 
II -2 GET KLAST VALUE 
TMP SAVE IT 

CALCULATE THE ADDRESS OF THE 

SIGN OF THE QUOTIENT 
KCRD1 GET KCARD ADDRESS 
TMP SUBTRACT KLAST VALUE 
SRCHT+1 ADD JSPAN 
ONE+1 ADD CONSTANT OF ONE 
L QUOT+1 STORE ADDR OF SIGN OF QUOTIENT 

IS KLAST-KSTRT-JSPAN NEGATIVE 
TMP LOAD KLAST VALUE 
KSTRT SUBTRACT KSTRT 
SRCHT+1 SUBTRACT JSPAN 
L ERR.+Z IF NEGATIVE-GO TO ERROR 

IS KLOW POSITIVE 
KLOW OK-GET KLOW VALUE 
L ERRt+ IF NOT POSITIVE-GO TO ERROR 

FILL THE EXTENSION OF KCARD WITH 

ZEROES 
FILL OK-FILL EXTENSION WITH ZEROES 
*-* ADDRESS OF KCARD 

KLOW ADDRESS OF LEFT END OF EXTENSION 
KSTRT ADDRESS OF RGHT END OF EXTENSON 
ZIP ADDRESS OF CONSTANT OF ZERO 

JFRST«J 
L2 *-* LOAD IR2 WITH JCARD COUNT 
L2 *-* PICKUP JCARDIJFRST) 

IS JCARDIJFRST) POSITIVE 
L HIT*-Z IF POSITIVE-GO TO HIT 

SEE IF JFRST IS LESS THAN JLAST. 

IF YES. JFRST-JFRST+1 AND GO 

BACK FOR MORE. IF NO. ERROR. 
2 -1 DECREMENT IR2 
SRCH GO BACK FOR MORE 

ERROR - NER-KLAST 

PICKUP KLAST VALUE 

AND STORE IN NER 

REPLACE JCARD SIGN 

PICKUP JCARD SIGN AND 
SGNJ+1 PUT IT BACK 

REPLACE KCARD SIGN 
KSIGN PICKUP KCARD SIGN 
KNEG.+Z IF NEGATIVE-GO TO KNEG 
SGNK+1 NOT NEGATIVE-PICKUP NEW SIGN 
SAVE1.- IF NOT NEGATIVE-GO TO EXIT 
HFFFF+1 NEGATIVE-CHANGE SIGN AND 
SGNK+1 PUT INTO KCARD(KLAST) 



II 



TMP 
-1 



DIV 
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CSP06330 
CSP06340 
CSP06350 
CSP06360 
CSP06370 
CSP06380 
CSP06390 
CSP06400 
CSP06410 
CSP06420 
CSP06430 
CSP06440 
CSP06450 
CSP06460 
CSP06470 
CSP06480 
CSP06490 
CSP06500 
CSP06510 
CSP06520 
CSP06530 
CSP06540 
CSP06550 
CSP06560 
CSP06570 
CSP06980 
CSP06590 
CSP06600 
CSP06610 
CSP06620 
CSP06630 
CSP06640 
CSP06650 
CSP06660 
CSP06670 
CSP06680 
CSP06690 
CSP06700 
CSP06710 
CSP06720 
CSP06730 
CSP06740 
CSP06750 
CSP06760 
CSP06770 
CSP06780 
CSP06790 
CSP06800 
CSP06810 
CSP06820 
CSP06830 
CSP06840 
CSP06850 
CSP06860 
CSP06870 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 
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ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



006B 
006C 
006E 
0070 

0071 
0073 
0075 
0077 
0079 
007A 
007B 
007C 
007D 

007E 
007F 



7005 

01 C4800029 
01 4C280071 
70F7 

00 65000000 
00 66000000 
00 67000000 
00 4C000000 
0000 
0000 
0000 
0000 
0000 



MDX 
KNEG LD 
BSC 
MDX 
* 

SAVE1 LDX 
SAVE2 LDX 
SAVE3 LDX 
D0NE1 BSC 
KSTRT DC 
KSIGN DC 
QSIGN DC 
ZIP DC 
KLOW DC 



000A 
0000 



TEN 
TMP 



0080 D0D3 



0081 
0082 
0083 
0084 
0085 
0086 
0087 

0088 
0089 
008A 
008B 
008C 
008D 
008E 
008F 
0090 
0091 
0092 
0093 
0094 
0095 
0096 
0097 



6A28 
COCC 
D03E 
90F8 
9024 
90B6 
D04E 

C0F6 
9020 
90D2 
DOCA 
90EC 
DOOB 
C033 
90EF 
8019 
D009 
D038 
D039 
80C8 
D009 
D01A 
D01B 



0098 00 65000000 



009A 00 C5000000 
009C A0E1 
009D 1090 
009E 00 85000000 
00A0 1890 
00A1 A8B2 
00A2 DODA 



DIV1 LD 
M 
SLT 

DIV2 A 

SRT 

D 

STO 



10 



DC 
DC 

STO 

STX 

LD 

STO 

S 

S 

S 

STO 

LD 

S 

S 

STO 

S 

STO 

LD 

S 

A 

STO 

STO 

STO 

A 

STO 

STO 

STO 



LOOPM LDX LI «-* 



LI 



PAGE 3 

SAVE1 GO TO EXIT CSP06880 

SGNK+1 NEGATIVE-PICKUP NEW SIGN CSP06890 

SAVE1»+Z IF NEGATIVE-GO TO EXIT CSP06900 

BCK1 NOT NEGATIVE-GO TO BCK1 CSP06910 

EXIT CSP06920 

*-* RESTORE IR1 CSP06930 

*-* RESTORE IR2 CSP06940 

»-* RESTORE IR3 CSP06950 

*-* RETURN TO CALLING PROGRAM CSP06960 

*-» ONE LESS THAN K CSP06970 

*-* SIGN OF KCARD CSP06980 

*-« SIGN OF QUOTIENT CSP06990 

CONSTANT OF ZERO CSP07000 

*-* SUBSCRIPT OF LEFTMOST POSITION CSP07010 

OF EXTENSION OF KCARD CSP07020 

CONSTANT OF TEN CSP07030 

TEMPORARY STORAGE CSP07040 

JHIGH-JCARD(JFRST) CSP07050 

SRCHT+1 SAVE FIRST SIGNIFICANT DIGIT CSP07060 

KPUT-KLOW+JLAST-JFRST CSP07070 

JLOOP+1 GET THE VALUE OF JLAST-JFRST CSP07080 

KCRD1 GET KCARD ADDRESS CSP07090 

KCRD2 SAVE FOR CARRY CSP07100 

KLOW SUBTRACT KLOW VALUE CSP07110 

JLOOP+1 SUBTRACT JLAST-JFRST VALUE CSP07120 

MTWO+1 ADD CONSTANT OF TWO CSP07130 

PUT2+1 SAVE ADDRESS FOR STORING CSP07140 

KSTOP-KLAST+JFRST-JLAST-1 CSP07150 

TMP GET KLAST VALUE CSP07160 

JLOOP+1 SUBTRACT JLAST-JFRST VALUE CSP07170 

HFFFF+1 ADD CONSTANT OF ONE CSP07180 

SRCH&l SAVE VALUE FOR COMPLIMENTING CSP07190 

KSTRT SUBTRACT KSTRT VALUE CSP07200 

LOOPM+1 SAVE COUNT AT LOOPM+1 CSP07210 

KCRD2 GET KCARD ADDRESS CSP07220 

TMP SUBTRACT KLAST VALUE CSP07230 

JLOOP&l ADD JLAST-JFRST VALUE CSP07240 

DIV1&1 SAVE FOR MULT. BY TEN CSP07250 

DIV5&1 SAVE FOR ADD OF 10«KNOW CSP07260 

DIV6&1 SAVE FOR STORE OF 10«KNOW CSP07270 

HFFFF+1 SUBTRACT CONSTANT OF ONE CSP07280 

DIV2&1 SAVE FOR ADD INTO MULT CSP07290 

DIV3&1 SAVE FOR SUBTRACTION FROM CSP07300 
DIV4&1 SAVE FOR STORE SUBTRACTED FROM CSP07310 

KM«KSTRT CSP07320 

LOAD IR1 WITH COUNT CSP07330 

MULT-(10#KCARD<KM)+KCARD(KM+1)1 CSP07340 

DIVIDED BY JHIGH CSP07350 

PICKUP KCARD (KM) CSP07360 

MULTIPLY BY TEN CSP07370 

REPOSITION PRODUCT CSP07380 

ADD IN KCARDIKM+1) CSP07390 

REPOSITION FOR DIVISION CSP07400 

SRCHT+1 DIVIDE BY JHIGH CSP07410 

KLOW SAVE IN KLOW(MULT) CSP07420 



TEN 
16 



16 
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» 








NQUO-MULT 


CSP07430 


00A3 





D0D5 




STO 




KSTRT SAVE IN KSTRT (NQUO) 


CSP07440 








« 








IS MULT GREATER THAN ZERO 


CSP07450 


00A4 


01 


4C0800D4 


• 


BSC 


L 


PUT. 


+ IF MULT NOT POSIT IVE-GO TO PUT 

KNOW-KM+1 


CSP07460 
CSP07470 


00A6 





6901 


ADBCK 


STX 


1 


KNOW+1 POSITIVE-GET KM+1 AND 


CSP07480 


00A7 


00 


67000000 


KNOW 

« 


LDX 


L3 


«•« 


PUT IT IN IR3 
JNOW-JFRST 


CSP07490 
CSP07500 


0OA9 


00 


66000000 


JLOOP 


LDX 


L2 


«-« 


RELOAD IR2 WITH REMAINING JCARD 


CSP07510 


OOAB 





1810 


« 
• 


SRA 




16 


CLEAR ACCUMULATOR 
KCARD ( KNOW ) -KCARD ( KNOW ) 

MULT*JCARD(JNOW) 


CSPO7520 
CSP07530 
CSP07540 


00 AC 


00 


96000000 


MUUT1 


S 


L2 


*-* 


LOAD NEGATIVE JCARD(JNOW) 


CSP07550 


OOAE 





AOCE 




M 




KLOW 


MULTIPLY BY MULT 


CSP07560 


OOAF 





1090 




SLT 




16 


REPOSITION PRODUCT 


CSP07570 


00 BO 


00 


87000000 


0IV3 


A 


L3 


«-* 


ADD IN KCARD(KNOW) 


CSP07580 


00B2 


00 


D7000000 


DIV4 

* 


STO 


L3 


*"* 


STORE AT KCARD (KNOW) 
KNOW-KNOW+1 


CSP07590 
CSP07600 


00B4 





73FF 




MDX 


3 


-1 


DECREMENT IR3 


CSP07610 


0OB5 





7000 


• 
» 


MDX 




* 


NOP 

IS JNOW LESS THAN JLAST. IF YES 
JNOW-JNOW+1 AND GO BACK FOR MORE 
IF NO. RESOLVE CARRIES. 


CSP07620 
CSP07630 
CSP07640 
CSP07650 


00B6 





72FF 




MDX 


2 


-1 


DECREMENT IR2 


CSP07660 


00B7 





70F3 




MDX 




JLOOP+2 NOT DONE-GO BACK FOR MORE 


CSP07670 


00B8 





69EF 




STX 


1 


KNOW+1 DONE-CALCULATE 


CSP07680 


00B9 





C09C 




LD 




SRCH61 THE VALUE OF 


CSP07690 


OOBA 





90ED 




S 




KNOW+1 KNOW-1 


CSP07700 


OOBB 





DOEC 




STO 




KNOW+1 BY COMPLIMENTING COUNT 


CSP07710 


OOBC 





6BDC 




STX 


3 


LOOPM+1 CALCULATE THE 


CSP07720 


OOBD 





C098 




LD 




SRCH&l VALUE OF KM 


CSP07730 


OOBE 





900A 




S 




LOOPM+1 BY COMPLIMENTING THE 


CSP07740 


OOBF 





D009 




STO 




LOOPM+1 OTHER COUNT 


CSP07750 








* 








RESOLVE CARRIES IN THIS RESULT 


CSP07760 


OOCO 


30 


03059668 




CALL 




CARRY RESOLVE CARRIES 


CSP07770 


00C2 





0000 


KCRD2 


DC 




#-# 


ADDRESS OF KCARD 


CSP07780 


00C3 


1 


00A8 




DC 




KNOW+1 ADDRESS OF KM 


CSP07790 


0OC4 


1 


0099 




DC 




LOOPM+1 ADDRESS OF KNOW-1 


CSP07800 


00C5 


1 


00A8 




DC 




KNOW+1 ADDRESS OF GENERATED CARRY 


CSP07810 








* 








IS KNOW LESS THAN ZERO 


CSP07820 


00C6 


01 


4C1000D4 


« 


BSC 


L 


PUT. 


- IF NOT NEGATIVE-GO TO PUT 
KCARD ( KM ) -KCARD ( KM ) +10«KNOW 


CSP07830 
CSP07840 


00C8 





A0B5 




M 




TEN 


NEGATIVE-MULTIPLY CARRY BY TEN 


CSP07850 


O0C9 





1090 




SLT 




16 


REPOSITION PRODUCT 


CSP07860 


OOCA 


00 


85000000 


DIV5 


A 


LI 


«-* 


ADD IN KCARD(KNOW) 


CSP07870 


00 CC 


00 


05000000 


0IV6 

* 


STO 


LI 


«-* 


STORE AT KCARD (KNOW) 
MULT— 1 


CSP07880 
CSP07890 


OOCE 





COSE 




LD 




HFFFF+1 LOAD A MINUS ONE 


CSP07900 


OOCF 





DOAD 


# 


STO 




KLOW 


STORE IN MULT 
NQUO-NQUO-1 


CSP07910 
CSP07920 


0000 





C0A8 




LD 




KSTRT LOAD THE VALUE OF NQUO 


CSP07930 


00D1 





808B 




A 




HFFFF+1 SUBTRACT CONSTANT OF ONE 


CSP07940 


0002 





D0A6 




STO 




KSTRT STORE IN NQUO 


CSP07950 


0003 





70D2 




MDX 




ADBCK GO TO ADD OVERDRAW BACK 


CSP07960 








* 








KCARD (KPUT) "NQUO 


CSP07970 



00D4 C0A4 
0005 00 D4000000 



00D7 01 74FF00D6 



PUT LD 
PUT2 STO 



00D9 


71FF 




MDX 




00 DA 


70BF 


* 


MDX 




OODB 


C09F 


LD 




OODC 01 


4C2800E8 




BSC 


L 


OODE 00 


C4000000 


QUOT 


LD 


L 


OOEO 01 


4C10005E 




BSC 


L 


00E2 01 


F^00005D 


BCK2 


EOR 


L 


00E4 01 


D48000DF 




STO 


I 


00E6 01 


4C00005E 




BSC 


L 


00E8 01 


C48000DF 


NEG 


LD 


I 


OOEA 01 


4C28005E 




BSC 


L 


OOEC 


70F5 




MDX 




OOEE 






END 





KSTRT LOAD NQUO 

*-» STORE AT KCARD(KPUT) 

KPUT-KPUT+1 
PUT2+1.-1 MODIFY KCARD(KPUT) ADDRESS 

SEE IF KM IS LESS THAN KSTOP. 

IF YES. KM-KM+1 AND GO BACK FOR 

MORE. IF NO. PLACE ALL SIGNS. 
-1 DECREMENT IR1 
DIV1 NOT DONE-GO BACK FOR MORE 

PUT SIGN ON QUOTIENT 
QSIGN DONE-PICKUP SIGN OF QUOTIENT 
NEG.+Z IF NEGATIVE-GO TO NEG 
*-* NOT NEGATIVE-PICKUP ACTUAL SIGN 
FINER.- IF NOT NEGATIVE-GO TO OTHERS 
HFFFF+1 NEGATIVE-CHANGE SIGN 
QUOT+1 PUT SIGN ON QUOTIENT 
FINER. GO TO REPLACE OTHER SIGNS 
QUOT+1 NEGATIVE-PICKUP ACTUAL SIGN 
FINER. +Z IF NEGATIVE-GO TO OTHER SIGN 
BCK2 GO TO CHANGE SIGN 
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CSP07980 
CSP07990 
CSP08000 
CSP08010 
CSP08020 
CSP08030 
CSP08040 
CSP08050 
CSP08060 
CSP08070 
CSP08080 
CSP08090 
CSP08100 
CSP08110 
CSP08120 
CSP08130 
CSP08140 
CSP08150 
CSP08160 
CSP08170 
CSP08180 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



NO ERRORS IN ABOVE ASSEMBLY. 



// DUP 
♦STORE 
334B OOOF 



WS UA OIV 



CSP08190 
CSP08200 



163 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



// ASM 

•• DPACK/DUNPK SUBROUTINES FOR 

• NAME DUNPK 

• LIST 

0000 04915502 ENT 



1130 COMMERCIAL SUBROUTINE PACKAGE 



(10) 
(ID) 



0006 



045C10D2 



0000 





0000 


DUNPK 


DC 




0001 





C003 




LD 




0002 


O 


D020 




STO 




0003 





7007 




MDX 




0004 





7027 


swi 


MDX 


X 


0005 





7000 


SW2 


MDX 


X 


0006 





0000 


DPACK 


DC 




0007 





COFE 




LD 




0008 





D0F7 




STO 




0009 





COFA 




LD 




000A 





D018 




STO 




OO0B 





6952 


START 


STX 


1 


0OOC 





6A53 




STX 


2 


000D 


01 


65800000 




LDX 


11 


000F 





C100 




LD 


1 


0010 





8001 




A 




0011 


00 


95800001 


ONE 


S 


11 


0013 





DOOD 




STO 




0014 





C103 




LD 


1 


0015 





80FC 




A 




0016 


00 


95800004 


FOUR 


S 


11 


00 18 





D006 




STO 




0019 





C100 




LD 


1 


001A 





80F7 




A 




001B 


00 


95800002 




S 


11 


001D 





D0E8 




STO 




001E 


00 


65000000 


KCARD 


LDX 


LI 


0020 


00 


C4000000 


JCARD 


LD 


L 


0022 





6204 




LDX 


2 


0023 





7000 


SWTCH 


MDX 


X 


0024 





1890 




SRT 




0025 





COFB 




LD 




0026 





90DF 




S 




0027 


01 


4C080059 




BSC 


L 


0029 





1810 


AGAIN 


SRA 




002A 





1084 




SLT 




002B 





FOOA 




EOR 




002C 


01 


4C180031 




BSC 


L 


002E 





F007 




EOR 




002F 





D100 




STO 


1 


0030 





71FF 




MDX 


1 


0031 





72FF 


NEXT 


MDX 


2 



0032 70F6 

0033 01 74FF0021 



0035 

0036 

0037 01 
0039 
003A 
003B 
003C 01 
003E 
003F 
0040 
0041 
0042 
0043 
0044 
0045 
0046 01 

0048 

0049 01 
0048 
004C 
004D 01 

004F 

0050 

0051 01 
0053 
0054 
0055 
0056 
0057 
0058 
0059 
005A 
005B 01 
005D 00 
005F 00 
0061 01 
0063 
0064 



70EA 

OOOF 

74010021 

6AE5 

C0E4 

90DB 

4C180046 

1884 

C023 

18DC 

72FF 

70FC 

1090 

D100 

71FF 

C4800021 

7011 

0*800021 

100C 

18DC 

74FF0021 

C0D1 

90B5 

4C280037 

72FF 

70F4 

1090 

D100 

71FF 

70C7 

1090 

D100 

74050000 

65000000 

66000000 

4C800000 

F000 



MDX 
MDX 

* 

MDX 

H000F DC 

EN MDX 
STX 
LD 
S 

BSC 
SRT 

BACK LD 
RTE 
MDX 
MDX 
SLT 
STO 
MDX 

LAST LD 
MDX 

OVR LD 

ELSE SLA 
RTE 
MDX 

LD 

S 

BSC 

MDX 

MDX 

SLT 

STO 

MDX 

MDX 

ALLDO SLT 
STO 
MDX 

SAVE1 LDX 

SAVE2 LDX 
BSC 

HF000 DC 
END 



DUNPK DUNPK SUBROUTINE ENTRY POINT 

CALL DUNPK (JCARD. J. JLAST. KCARD.K) 

THE WORDS JCARD(J) THROUGH 

JCARD(JLAST) IN D4 FORMAT ARE 

UNPACKED INTO KCARD IN Dl FORMAT* 

DPACK DPACK SUBROUTINE ENTRY POINT 

CALL DPACK (JCARD* J* JLAST. KCARD. K) 

THE WORDS JCARD (J) THROUGH 

JCARD (JLAST) IN Di FORMAT ARE PACKED 

INTO KCARD IN D4 FORMAT. 

*-* ARGUMENT ADDRESS COMES IN HERE 

SW2 LOAD NOP INSTRUCTION 

SWTCH STORE NOP AT SWITCH 

START COMPUTING 

ELSE-SWTCH-1 BRANCH TO ELSE 

NOP INSTRUCTION 

♦-« ARGUMENT ADDRESS COMES IN HERE 

DPACK PICK UP ARGUMENT ADORESS 

DUNPK AND STORE IT IN DUNPK 

SWI LOAD BRANCH TO ELSE 

SWTCH STORE BRANCH AT SWITCH 

SAVE1+1 SAVE IR1 

SAVE2+1 SAVE IR2 
II DUNPK PUT ARGUMENT ADDRESS IN IR1 

GET JCARD ADDRESS 

ONE+1 ADD CONSTANT OF 1 
II 1 SUBTRACT J VALUE 

JCARD+1 CREATE JCARD(J) ADDRESS 

3 GET KCARD ADDRESS 
ONE+l ADD CONSTANT OF 1 

4 SUBTRACT K VALUE 
KCARD+1 CREATE KCARD(K) ADDRESS 
GET JCARD ADDRESS 
ONE+1 ADD CONSTANT OF 1 
2 SUBTRACT JLAST VALUE 
DPACK CREATE JCARD( JLAST) ADDRESS 
*-« PUT KCARD ADDRESS IN IR1 
»-« PICK UP JCARD(J) 
4 LOAD IR2 WITH 4. DIGITS/WORD 
SWITCH BETWEEN DPACK AND DUNPK 
16 TEMPORARILY SAVE ACCUM IN EXTNTN 

CHECK FOR JCARD( JLAST) 
JCARD+1 PICK UP CURRENT JCARD ADDR 
DPACK SUBTRACT JCARD(JLAST) 
ALLDO. + IF ZERO. ALL DONE - ALLDO 
16 NOT DONE - CLEAR ACCUMULATOR 
4 GET FIRST DIGIT OF WORD 
HOOOF IS IT FILLER 
NEXT.+- YES - GO TO NEXT 
HOOOF NO - RESTORE TO ORIGINAL 
STORE IN KCARD 
-1 GO TO NEXT WORD OF KCARD 
-1 DECREMENT DIGITS/WORD 



CSP08210 
CSP08220 
CSP08230 
CSP08240 
CSP08250 
CSP08260 
CSP08270 
CSP08280 
CSP08290 
CSP08300 
CSP08310 
CSP08320 
CSP08330 
CSP08340 
CSP08350 
CSP08360 
CSP08370 
CSP08380 
CSP08390 
CSP08400 
CSP08410 
CSP08420 
CSP08430 
CSP08440 
CSP08450 
CSP08460 
CSP08470 
CSP08480 
CSP08490 
CSP08500 
CSP08510 
CSP08520 
CSP08530 
CSP08540 
CSP08550 
CSP08560 
CSP0857O 
CSP08580 
CSP08590 
CSP08600 
CSP08610 
CSP0862O 
CSP08630 
CSP08640 
CSP08650 
CSP08660 
CSP08670 
CSP08680 
CSP08690 
CSP08700 
CSP08710 
CSP0872O 
CSP08730 
CSP08740 
CSP08750 
CSP08760 
CSP08770 



AGAIN MORE IN THIS WORD - GO BACK 
L JCARD+1. -1 THIS WORD DONE 

GET NEXT WORD IN JCARD 
JCARD GO BACK 

/OOOF CONSTANT OF 15 TO DETECT FILLER 
L JCARD+1. 1 BACK UP JCARD FOR SIGN 
2 KCARD+1 IF DIGITS/WORD IS FOUR. 
KCARD+1 ALL DONE EXCEPT FOR SIGN 
FOUR+1 SUBTRACT FOUR FROM DIGITS/WORD 
L LAST.+- IF ZERO - ALL DONE - GO LAST 
4 NOT DONE - TAKE OUT SIGN 
HFO00 PUT IN FILLER 

28 SET FILLER IN LOW ORDER OF EXTN 
2 -1 DECREMENT DIGITS/WORD 
BACK MORE - GO BACK 
16 DONE - PUT EXTENSION IN ACCUM 
1 STORE IN KCARD 

1 -1 GET NEXT WORD OF KCARD FOR SIGN 
I JCARD+1 PICK UP SIGN OF JCARD 

ALLDO+1 GO TO INSTRUCTION AFTER ALLDO 
I JCARD+1 PICK UP NEXT JCARD DIGIT 

12 PUT DIGIT IN HIGH ORDER OF ACC 

28 SET DIGIT IN LOW ORDER OF EXTN 
L JCARD+1. -1 GET NEXT JCARD WORD 
CHECK FOR JCARD( JLAST) 

JCARD+1 PICK UP CURRENT JCARD ADDR 

DPACK SUBTRACT JCARD( JLAST) 
L EN.+Z IF ZERO.ALL DONE - GO TO EN 

2 -1 NOT DONE-DECREMENT DIGITS/WORD 
OVR GO BACK FOR NEXT DIGIT 

16 WORD FULL-PUT EXTN IN ACCUM 
1 STORE IN KCARD 
1 -1 GET NEXT KCARD WORD 
JCARD GO BACK 

16 DONE-PUT EXTENSION IN ACCUMULTR 
1 STORE SIGN IN KCARD 
L DUNPK .5 CREATE RETURN ADDRESS 
LI «-* RESTORE IR1 
L2 *-* RESTORE IR2 

I DUNPK RETURN TO CALLING PROGRAM 
/F000 CONSTANT OF 15 FOR FILLER 
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CSP08780 
CSP08790 
CSP08800 
CSP08810 
CSP08820 
CSP08830 
CSP08840 
CSP08850 
CSP08860 
CSP08870 
CSP08880 
CSP08890 
CSP08900 
CSP08910 
CSP08920 
CSP08930 
CSP08940 
CSP08950 
CSP08960 
CSP08970 
CSP08980 
CSP08990 
CSP09000 
CSP09010 
CSP09020 
CSP09030 
CSP09040 
CSP09050 
CSP09060 
CSP09070 
CSP09080 
CSP09090 
CSP09100 
CSP09110 
CSP09120 
CSP09130 
CSP09140 
CSP09150 
CSP09160 
CSP09170 
CSP09180 
CSP09190 



NO ERRORS IN ABOVE ASSEMBLY. 
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Form H20-0241-3 
Revised 10/11/68 
ByTNLN20-1888 



// OOP 
•STORE 
33SA 0007 



WS UA DUNPK 



CSP09200 
CSP09210 



// ASM 

•• EOIT SUBROUTINE FOR 1130 COMMERCIAL SUBROUTINE PACKAGE 

• NAME EDIT 

* LIST 



CSP09220 
(ID) CSP09230 
(ID) CSP09240 

CSP09250 



0000 





0000 


EDIT 


DC 




0001 





696D 




STX 


1 


0002 





6A6E 




STX 


2 


0003 


01 


65800000 




LDX 


U 


0005 





■C100 




LD 


1 


0006 





D02B 




STO 




0007 





D07D 




STO 




0008 


00 


95800002 




S 


11 


000A 





8007 




A 




000B 





D050 




STO 




OOOC 





C102 


TWO 


LD 


1 


OOOD 





D025 




STO 




OOOE 





D077 




STO 




OOOF 


00 


C5800JC2 




LD 


11 


0011 


00 


95800001 


ONE 


S 


11 


0013 





80FE 




A 




0014 





4608 




BSC 




0015 





COFC 




LD 




0016 





D026 




STO 




0017 





C104 




LD 


1 


0018 





D077 




STO 




0019 


01 


D40000C1 




STO 


L 


001B 





C105 




LD 


1 


001C 





D074 




STO 




001D 





C103 




LD 


1 


001E 





D070 




STO 




001F 


01 


D40000CO 




STO 


L 


0021 


00 


95800005 




S 


11 


0023 





80EE 




A 




0024 





D01A 




STO 




0025 





D07F 




STO 




0026 


00 


C5800005 




LD 


11 


0028 


00 


95800004 


FOUR 


S 


11 


002A 





80E7 




A 




002B 





4808 




BSC 




002C 


0- 


C0E5 




LD" 




002D 





DOOD 




STO 




002E 





7106 




MDX 


1 


002F 





6943 




STX 


1 


0030 


30 


15A56545 


CALL 




0032 





0000 


JCRD1 


DC 




0033 





0000 


JLAS1 


DC 




0034 


1 


0029 




DC 




0035 


1 


OOCA 


* 


DC 




0036 





C85E 


* 


LDD 





EDIT EDIT SUBROUTINE ENTRY POINT CSP09260 

CALL EDITUCARDiJ.JLAST.KCARDtK.rf.LAST) CSP09270 

THE WORDS JCARD(J) THROUGH CSP09280 

JCARD(JLAST) ARE EDITED UNDEfc CSP09290 

CONTROL OF THE MASK AT WORDS CSP09300 

KCARDio through kcardiklasti CSP09310 

and the result is at kcardik) csp09320 

through kcardiklasti. cspo933o 

»-* argument address comes in here csp09340 

save1+1 save ir1 csp09350 

save2+1 save ir2 csp09360 

ii edit put argument address in ir1 csp09370 

get jcard address csp09380 
jcrd1 save jcard address for nzone csp09390 
jcrd2 save jcard address for nzone csp0940c 
2 subtract jlast value csp09410 
one + l add constant of one csp09420 
jcard+1 create jcakd(jlast) address csp09430 
2 get jlast address csp09440 

JLAS1 SAVE JLAST ADDRESS FOR NZUNE CSPC9450 

JLAS2 SAVE JLAST ADDRESS FOR NZONE CSP09460 

2 GET JLAST VALUE CSP09470 

1 SU3TRACT J VALUE CSP09480 
ONE+l ADD CONSTANT OF ONE CSP09490 
+ CHECK FIELD WIDTH CSP09500 
ONE+l NEGATIVE OR ZERO-MAKE IT ONE CSP09510 
LDXJ+1 SAVE FIELD V.IDTH CSP09520 

4 GET K ADDRESS CSPQ953U 
Kl SAVE K ADDRESS FOR FILL CSP09540 
K2 SAVE K ADDRESS FOR FILL CSP09550 

5 GET KLAST ADDRESS CSP09560 
KLAS1 SAVE KLAST ADDRESS FOR FILL CSP09570 

3 GET KCARD ADDRESS CSP09580 
KCRD1 SAVE KCARD ADDRESS FUR FILL CSP09590 
KCRD2 SAVE KCARD ADDRESS FOR FILL CSP09600 
5 SUBTRACT KLAST VALUE CSP09610 
ONE+l ADD CONSTANT OF ONE CSP09620 
KCARD+1 CREATE KCARDIKLASTI ADDRESS CSP09630 
KCRD3+1 CREATE KCARDIKLASTI ADDRESS CSP09640 

5 GET JLAST VALUE CSP09650 

4 SUBTRACT J VALUE CSP09660 
ONE+l ADD CONSTANT OF ONE CSP09670 
+' CHECK FIELD WIDTH CSP09680 
ONE+l NEGATIVE OR ZERO-MAKE IT UNE CSP09690 
LDXK+1 SAVE FIELD WIDTH CSP09700 

6 MOVE OVER SIX ARGUMENTS CSP09710 
1 D0NE1+1 CREATE RETURN ADDRESS CSP09720 

REMOVE AND SAVE THE JCARD ZONE CSP09730 

NZONc NZONE TO REMOVE SIGN CSP09740 

»-* ADDRESS OF JCARD CSP09750 

*-* ADDRESS OF JLAST CSP09760 

FOUR+1 ADDRESS OF A FOUR CSP09770 

NSIGN ADDRESS OF OLD SIGN INDICATOR CSP09780 

NDUMP=l6448 CSP09790 

M0NEY=16448 CSP09800 

BLANK LOAD TWO BLANKS CSP09810 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 
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ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



0037 D85E 



0038 
0039 






1810 
D05E 


* 
LDXK 


SRA 
STO 


003A 


00 


65000000 


LDX 


003C 


00 


66000000 


LDXJ 
KCARD 


LDX 


003E 
0040 


00 



C4OC00O0 
,D0FA 


LD 
STO 


0041 


01 


4C100047 


BSC 


0043 
0044 
0046 




01 




9050 

4C20007F 

700F 




S 
BSC 

MDX 


0047 
0048 
004A 




01 




904D 

4C180057 

C0F0 


POSZ 

# 


S 

BSC 

LD 


004B 
004C 
004E 




01 




904E 

4C180054 

C0EC 


S 

BSC 

LD 


004F 
0050 
0051 







9049 
4820 
702D 


S 

BSC 

MDX 


0052 
0053 






C0E8 
D043 


MNY 


LD 
STO 


0054 
0055 


c 




C0E6 
D040 


LD 
STO 



0056 6941 



0057 6AA8 

0058 C0A7 

0059 01 4C08007F 



005B 00 C4000000 

005D 01 D480003F 

005F DODD 

0060 72FF 

0061 7000 

0062 01 7401005C 



STX 

LD 

BSC 



JCARD LD 
STO 
STO 



MDX 
MDX 
MDX 



PAGE 2 

MONEY STORE IN MONEY AND NDUMP CSPC9820 

NZRSP=0 CSP09830 

16 CLEAR THE ACCUMULATOR CSP09840 

NZRSP SET NZRSP EQUAL TO ZtRO CSP09850 

KNOW=KLAST CSP09860 

«-* LOAD IR1 WITH KCARD COUNT CSP09870 

JNOW=JLAST CSP09880 

*-* LOAD IR2 WITH JCARD COUNT CSP09890 

KTEST=KCARD<KNOw) CSP09900 

*-* PICKUP KCARDIKNOw) CSP09910 

LDXK+1 AND SAVE IT TEMPORARILY CSP09920 

IS KTEST NEGATIVE CSP09930 
POSZt- IS IT NEGATIVE-NO-GO TO POSZ CSP09940 

IS KTEST EQUAL TO AN EBCDIC ZERO CSP09950 
ZERO YES-CHECK AGAINST EBCDIC ZERO CSP09960 

NEXTiZ IF NOT EQUAL-GO TO NEXT CSP09970 

ZRSP IF EQUAL-GO TO ZKSP CSP09980 

IS KTEST EQUAL TO 16448 CSP09990 

BLANK NOT NEGATIVE-CHECK AGAINST E3CD CSP10000 

SRCE.+- BLANK-EQUAL-GO TO SRCE CSPltfOlO 

LDXK+1 NOT EQUAL-PICKUP KTEST CSP10020 

IS KTEST EQUAL TO 23616 CSP10030 

DLRSG IS IT A DOLLAR SIGN CSP10040 

MNY.+- YES-GU TO MNY CSP10050 

LDXK+1 NO-PICKUP KTEST CSP10060 

IS KTEST EQUAL TO 23360 CSP10070 

AST IS IT AN ASTERISK CSP1O080 

Z YES-SKIP NEXT INSTRUCTION CSP10090 

NEXT NO-GO TO NEXT CSP10100 

NDUMP-KTEST CSP1J110 

LDXK+1 PICKUP KTEST AND CSP10120 

NDUMP STORE IT IN NDUMP CSP10130 

MONEY=KTEST CSP10140 

LDXK+1 PICKUP KTEST AND CSP10150 

MONEY STORE IT Il\ MONEY CSP10160 

NZRSP=KNOW CSP10170 

NZRSP SAVE KNOW IN NZRSP CSP10180 

SEE IF JNOW IS LESS THAN J. IF CSP10190 

YES» GO TO NEXT. IF NO. GO TO CSP10200 

JCARD. CSP10210 

EDIT GET IR1 AND CSP10220 

EDIT LOAD ITS VALUE CSP1C230 

NEXT.+ IF NOT POSITIVE-GO TO NEXT CSP10240 

KTEST = JCARDUNOw) CSP1O250 

KCARD(KNOW>=KTEST CSP10260 

*-* POSITIVE-PICKUP JCARD(JNOW) AND CSP10270 

KCARD+1 STORE IT IN KCARD(KNOW) CSP10280 

LDXJ+1 STORE IN KTEST CSP10290 

JNOW«JN0W-l CSP10300 

-1 DECREMENT IR2 CSP10310 

* , NOP CSP10320 

JCARD+1.1 MODIFY JCARD ADDRESS TO CSP10330 

JNOW-1 CSP10340 
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0064 


C033 




LD 




0065 01 


4C08007F 




BSC 


L 


0067 


C0D5 




LD 




0068 01 


4C100074 




BSC 


L 


006A 


9029 




S 




006B 01 


4C18007F 




BSC 


L 


0060 


700D 


SAVE1 


MDX 




006E 00 


65000000 


LDX 


LI 


0070 00 


66000000 


SAVE2 


LDX 


L2 


0072 00 


4C000000 


D0NE1 

• 

OVER 


BSC 


L 


0074 


9020 


S 




0075 01 


4C18007F 




BSC 


L 



0077 C0C5 

0078 9022 

0079 01 4C18007F 

007B 691C 

007C 01 74FF0098 

007E 7000 



007F 01 7401003F 



SETAG STX 

MDX 
MDX 



0081 





71FF 




MDX 


0082 





70BB 


• 


MDX 


0083 


30 


15A56545 


CALL 


0085 





0000 


JCRD2 


DC 


0086 





0000 


JLAS2 


DC 


0087 


1 


OOCA 




DC 


0088 


1 


0000 


• 
• 


DC 


0089 





6AA8 


STX 


008A 





C0A7 




LD 


008B 


01 


4C0800A0 




BSC 


008D 


30 


062534C0 


KCRD1 


CALL 


008F 





0000 


DC 


0090 





0000 


Kl 


DC 


0091 





0000 


KLAS1 


DC 


0092 


1 


0099 




DC 


0093 





70DA 




MDX 


0094 





F040 


ZERO 


DC 


0095 





4040 


BLANK 


DC 


0096 





0000 


MONEY 


DC 


0097 





0000 


NDUMP 


DC 



0098 





0000 


NZRSP 


DC 


0099 





5C40 


AST 


DC 


009A 





5B40 


DLRSG 


DC 


009B 





6B40 


COMMA 


DC 


009C 





6040 


MINUS 


DC 


009D 





D940 


R 


DC 


009E 





0001 


0NE2 


DC 


009F 





0002 


TW02 
OH 


DC 


OOAO 





C029 


LD 


00A1 





90FD 




S 


00A2 


01 


4C1800B7 


• 
KCRD3 


BSC 


00A4 


00 


C4000000 


LD 


00A6 





90F5 




S 


00A7 


01 


4C1800B4 




BSC 


00A9 





80F2 




A 


OOAA 





90F2 




S 


OOAB 


01 


4C2000B7 




BSC 


OOAD 


01 


740100A5 


• 


MDX 


OOAF 





C0E5 


• 


LD 


OOBO 


01 


D48000A5 




STO 


00B2 


01 


74FF00A5 


« 
LD2 


MDX 


00B4 





COEO 


LD 


00B5 


01 


D48000A5 


• 
NEG 


STO 


00B7 





COEO 


LD 


0OB8 


01 


4C08006E 




use 


OOBA 


01 


84800090 




A 


OOBC 





90E1 




S 


OOBD 





D0E7 




STO 



IS NZRSP POSITIVE 
NZRSP PICKUP NZRSP AND 
NEXT.* IF NOT POSITIVE-GO TO NEXT 

IS KTEST NEGATIVE 
LDXJ+1 POSITIVE-PICKUP KTEST 
OVERt- IF NOT NEGATIVE-GO TO OVER 
ZERO NEGATIVb-CHfcCK AGAINST ZERO 
NEXTi+- EQUAL-GO TO NEXT 
SETAG NOT EQUAL-GO TO SETAG 

EXIT 

*-» RESTORE IR1 
»-« RESTORE IR2 
*»« RETURN TO CALLING PROGRAM 

IS KTEST EQUAL TO BLANK 
BLANK CHECK KTEST AGAINST BLANK 
NEXT.+- IF EQUAL-GO TO NEXT 

IS KTEST EQUAL TO COMMA 
LDXJ+1 NOT EQUAL-CHECK KTEST 
COMMA AGAINST A COMMA 
L NEXT.*- EQUAL-GO TO NEXT 

NZRSP-KNOW-1 
1 NZRSP NOT EQUAL-SET NZRSP EQUAL TO 
L NZRSPt-1 KCARD COUNT MINUS ONE 
* NO-OP 

SEE IF KNOW IS LESS THAN K. IF 

YES. PUT JCARD ZONE BACK. IF NO 

GO BACK FOR MORE. 
L KCARD+1.1 MODIFY KCARD ADDRESS TO 

KNOW-1 

1 -1 DECREMENT IR1 
KCARD GO BACK FOR MORE 

PUT JCARD ZONE BACK 
NZONE RESTORE JCARD ZONE 
«-» ADDRESS OF JCARD 
*-» ADDRESS OF JLAST 
NSIGN ADDRESS OF NEW SIGN INDICATOR 
EDIT DUMMY 

SEE IF JNOW IS LESS THAN J. IF 

YESi GO TO OK. IF NO. FILL WITH 

ASTERISKS AND EXIT 

2 JCRD1 GET THE CONTENTS OF 
JCRD1 IR2 AND CHECK 

L 0K.+ IF NOT POSITIVE-GO TO OK 

FILL POSITIVE-ERROR-JCARD TOO LONG 

FILL KCARD WITH ASTERISKS 
*-« ADDRESS OF KCARD 
»-• ADDRESS OF K 
»-» ADDRESS OF KLAST 
AST ADDRESS OF FILL CHARACTER 
SAVE1 GO TO EXIT 

E /F040 CONSTANT OF EBCDIC ZERO 
/4040 CONSTANT OF EBCDIC BLANK 
*-» FILL FOR FLOATING $ 
»-» FILL FOR ANY SUPPRESSION 
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CSP10350 
CSP1U360 
CSP10370 
CSP10380 
CSP10390 
CSP10400 
CSP1041C 
CSP10420 
CSP10430 
CSP10440 
CSP10450 
CSP10460 
CSP10470 
CSP104B0 
CSP10490 
CSP10500 
CSP10510 
CSP10520 
CSP10530 
CS.P10540 
CSP10550 
CSP10560 
CSP1057U 
CSP10580 
CSP10590 
CSP10600 
CSP10610 
CSP10620 
CSP10630 
CSP10640 
CSP10650 
CSP10660 
CSP10670 
CSP10680 
CSP10690 
CSP10700 
CSP10710 
CSP10720 
C5P10730 
CSP10740 
CSP10750 
CSP10760 
CSP10770 
CSP10780 
CSP10790 
CSP10800 
CSP10810 
CSP10820 
CSP10830 
CSP10840 
CSP10B50 
CSP10860 
CSP10870 
CSP10880 



OOBE 30 062534C0 CALL 

OOCO 0000 KCRD2 DC 

00C1 0000 K2 DC 

00C2 1 00A5 DC 

00C3 1 0097 DC 



00C4 


COFB 


LD 


00C5 


90DF 


S 


00C6 


80D7 


A 


00C7 


D002 


STO 


00C8 


COCD 


LD 


00C9 00 


D4000003 


STOK STO 


OOCA 




NSIGN EQU 


OOCB 


70A2 


MDX 


OOCC 




END 



»-» HOW FAR TO ZERO SUPPRESS 
/5C40 CONSTANT OF ASTERISK 
/5B40 CONSTANT OF DOLLAR SIGN 
/6B40 CONSTANT OF COMMA 
/6040 CONSTANT OF MINUS SIGN 
/D940 CONSTANT OF LETTER R 

1 CONSTANT OF ONE 

2 CONSTANT OF TWO 

IS NSIGN EQUAL TO TWO 
NSIGN PICKUP THE ORIGINAL ZONE 
TW02 INDICATOR AND CHECK AGAINST TWO 
NEG.+- EQUAL-GO TO NEG 

KTEST-KCARD(KLAST) 
»-• NOT EQUAL-PICKUP KCARDI KLAST I 
MINUS AND CHECK AGAINST MINUS SIGN 
LD2.+- IF EQUAL-GO TO LD2 
MINUS NOT EQUAL-GET KTEST AND CHECK 
R AGAINST LETTER R 
NEG.Z IF NOT EQUAL-GO TO NEG 
KCRD3+1.1 EQUAL-GET ADDRESS OF 
KCARD(KLAST-l) 

KCARDI KLAST-1 1-16448 
BLANK PICKUP A BLANK 
KCRD3+1 STORE AT KCARDIKLAST-1 ) 
KCRD3+1.-1 GET ADDR OF KCARD(KLAST) 

KCARDIKLASTI-16448 
BLANK PICKUP A BLANK 
KCRD3-M STORE AT KCARD(KLAST) 

IS NZRSP GREATER THAN ZERO 
NZRSP GET NZRSP AND 
SAVE1.+ IF NOT POSITIVE-EXIT 
Kl POSITIVE-CALCULATE SUBSCRIPT OF 
0NE2 LAST POSITION TO BE ZERO 
KCRD3+1 SUPPRESSED-END OF FILL AREA 

ZERO SUPPRESS 
FILL FILL ROUTINE TO ZERO SUPPRESS 
«-* ADDRESS OF KCARD 
•-* ADDRESS OF K 

KCRD3+1 ADDRESS OF END OF FILL AREA 
NDUMP ADDRESS OF FILL CHARACTER 

KCARD (NZRSP) -MONEY 
KCRD2 GET KCARD ADDRESS 
KCRD3+1 SUBTRACT LAST FILL VALUE 
0NE2 ADD CONSTANT OF ONE 
STOK+1 CREATE KCAKD(NZRSP) ADDRESS 
MONEY PICKUP MONEY VALUE 
.*-» STORE FOR SUPPRESSION 
STCK-t-1 TO SAVE CORE STORAGE 
SAVE1 GO TO EXIT 
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CSP10890 
CSP10900 
CSP10910 
CSP10920 
CSP10930 
CSP10940 
CSP10950 
CSP10960 
CSP10970 
CSP10980 
CSP10990 
CSP11000 
CSP11010 
CSP11020 
CSP11030 
CSP11040 
CSP11050 
CSP11060 
CSP11070 
CSPH080 
CSP11090 
CSP11100 
CSP11110 
CSP11120 
CSP11130 
CSP11140 
CSP11150 
CSP11160 
CSP11170 
CSP11180 
CSP11190 
CSP11200 
CSP1121C 
CSP11220 
CSP11230 
CSP11240 
CSP11250 
CSP11260 
CSP11270 
CSP11280 
CSP11290 
CSP11300 
CSP11310 
CSP11320 
CSP11330 
CSP11340 
CSP11350 
CSP11360 
CSP11370 
CSP11330- 
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ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



NO ERRORS IN ABOVE ASSEMBLY. 
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ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



// DUP 
•STORE 
3361 000D 



WS UA EDIT 



CSP11390 
CSP1U00 



// ASM 

•» FILL SUBROUTINE 

• NAME FILL 

* LIST 

0000 O62534C0 



FOR 1130 COMMERCIAL SUBROUTINE PACKAGE 



(ID) 
(ID) 



0000 
0001 
0002 
0004 
0005 
0007 
0008 
000A 
000C 
000D 
000E 
000F 
0010 
0012 
0013 



00C0 

6919 

01 65800000 
C100 

00 95800002 
DOOF 
00 C5800002 
00 95800001 
80FE 
4808 
COFC 
D005 
00 C5800003 
7104 
6909 



0014 00 65000000 



0016 00 D5000000 



0018 71FF 

0019 70FC 

001A 00 65000000 

001C 00 4C000000 
001E 



FILL DC 
STX 
LDX 
LD 
S 

STO 
LD 

ONE S 
A 

BSC 
LD 
STO 
LD 
MDX 
STX 

• 

LDX LDX 

STO STO 



MDX 
MDX 
• 

SAVE1 LDX 

DONE1 BSC 

END 



FILL FILL SUBROUTINE ENTRY POINT 
CALL FILLUCARD.JtJLAST.NCH) 
THE WORDS JCARD(J) THROUGH 
JCARD(JLAST) ARE FILLED WITH THE 
CHARACTER AT LOCATION NCH. 
#-* ARGUMENT ADDRESS COMES IN HERE 
1 SAVE1+1 SAVE IR1 
II FILL PUT ARGUMENT ADDRESS IN IR1 

1 GET JCARD ADDRESS 
II 2 SUBTRACT VALUE OF JLAST 

STO+1 CREATE ADDRESS OF JCARD(JLAST) 
112 GET VALUE OF JLAST 
II 1 SUBTRACT VALUE OF J 
ONE+1 ADD CONSTANT OF ONE 
♦ CHECK FIELD WIDTH 
ONE+1 NEGATIVE OR ZERO - MAKE IT ONE 
LDX+1 OK - STORE FIELD WIDTH IN LDX 
II 3 GET FILL CHARACTER - NCH 
1 4 MOVE OVER FOUR ARGUMENTS 
1 DONE1+1 CREATE RETURN ADDRESS 
JNOW-J 

LOAD IR1 WITH FIELD WIDTH 
JCARD (JNOW) -NCH 
STORE FILL CHAR AT JCARD(JNOW) 
SEE IF JNOW IS LESS THAN JLAST* 
IF YES* JNOW-JNOW+1 AND GO BACK 
FOR MORE. IF NO* EXIT. 
DECREMENT FIELD WIDTH 
NOT DONE - GO BACK FOR MORE 

EXIT 

DONE - RESTORE IR1 
RETURN TO CALLING PROGRAM 



LI «-« 



LI •-• 



-1 
STO 



NO ERRORS IN ABOVE ASSEMBLY, 



// DUP 
•STORE 
336E 0003 



WS UA FILL 



CSP11410 
CSP11420 
CSP11430 
CSP11440 
CSP11450 
CSP11460 
CSP11470 
CSP11480 
CSP11490 
CSP11500 
CSP11510 
CSP11520 
CSP11530 
CSP11540 
CSP11550 
CSP11560 
CSP11570 
CSP11580 
CSP11590 
CSP11600 
CSP11610 
CSP11620 
CSP11630 
CSP11640 
CSP11650 
CSP11660 
CSP11670 
CSP11680 
CSP11690 
CSP11700 
CSP11710 
CSP11720 
CSP11730 
CSP11740 
CSP11750 
CSP11760 
CSP11770 



CSP11780 
CSP11790 
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// ASM 

** GET SUBROUTtNc 

* NAME GET 

* LIST 

OuOO 07163000 



FOR 1130 COMMERCIAL SUbRUUTlNE PACKAGE 



GE 



( 10) 
(10) 



oooo 





OOUO 


GET 


DC 




0001 





694R 




STX 


1 


0002 


01 


65800000 




LDX 


11 


0004 





C100 




LD 


1 


0005 





0013 




STO 




0006 





003C 




STO 




0007 


00 


95800002 


TWO 


S 


11 


0009 





0016 




STO 




OOOA 





C103 




LO 


1 


OOOB 





0033 




STO 




OOOC 


00 


C5800002 




LD 


U 


OOOE 





D0F1 




STO 




OOOF 


00 


95800001 


ONE 


S 


11 


0011 





80FE 




A 




0012 





4808 




BSC 




0013 





COFC 




LD 




0014 





OOOE 




STO 




0015 





7104 




MDX 


1 


0016 





6938 


• 


STX 


1 


0017 


30 


15A56545 


* 


CALL 




0019 





0000 


JCRD1 


DC 




001A 


1 


0000 




DC 




001B 


1 


0050 




DC 




001C 


1 


0019 




DC 




0010 





10A0 




SLT 




001E 





DB7E 




STD 


3 


001F 





037D 




STO 


3 


0020 


20 


058A3580 




LIBF 




0021 


1 


005A 


• 
GMT 


DC 




0022 


00 


65000000 


LDX 


LI 


0024 


00 


C5000000 


JCRD2 


LD 


LI 


0026 


01 


4C28002C 




BSC 


L 


0028 





9028 




S 




0029 


01 


4C200053 




BSC 


L 


002B 





C026 




LD 




002C 





9025 


MAYBE 


S 




002D 


01 


4C280053 




BSC 


L 



GET SUdRGUTIht ENTRY POInT 
GET (JCARD. J. JLAST. SHIFT) 
THE WORDS JCARDIJ) ThkOUGh 
JCARDULAST) ARE CONVERTED Tw A 
REAL NUMBER AND MULTIPLIED BY 
SHIFT TO PLACE THE DECIMAL POINT 

*-* ARGUMENT ADDRESS COMES In HERE 

FlN+1 SAVE IR1 

GET PUT ARGUMENT ADDRESS IN IR1 

GET JCARD ADDRESS 

JCRD1 STORE FOR NZONE AT JCR01 
JCRD3 STORE FOR NZUNE AT JCRD3 

2 SUBTRACT JLAST VALUE 

JCRD2 + 1 CREATE JCARDULAST) ADDRESS 

3 GET SHIFT ADDRESS AND 

SHIFT STORE FOR MULTIPLY To PLACt . 
2 GET JLAST VALUE AND 
GET SAVE FOR NZONE 

1 SUBTRACT J VALUE 
UNE+1 ADD CONSTANT OF ONE 
+ CHECK FIELD WIDTH 

ONE+1 NEGATIVE OR ZERO-MAKt IT 0.*t 
CNT+1 UK-SAVE FIELD WIDTH AT CuUnT 

4 MOVE OVER FOUR ARGUMENTS 
D0NE1+1 CREATE RETURN ADDRESS 

MAKE THE FIELD POSITIVE AND 

SAVE THE ORIGINAL SIGN 
NZONE NZONt TO CLEAR ORIGINAL SIG* 
• -* ADDRESS OF JCARD 
GET ADDRESS OF JLAST 
FOUR ADDRESS OF CONSTANT UF FOUR 
JCRD1 ADDRESS OF OLD SIGN INDICATuR 
32 CLEAR ACCUMULATOR AnD EXTENSION 

126 clear mantissa of fac 

125 clear Characteristic uf fac 

let get and ans be eouivalent 
estu store the contents of fac 
ans at get 

JNOW»J 
*-* LOAD IR1 WITH THE FIELD wIDTH 

JTEST=JCARD(JNOWI 
*-* PICKUP JCARD(JNOW) 
MAYBE. +Z IS JTEST NEGAT I VE-YES-MAYBE 
BLANK NO - IS JTEST EQUAL TO AN 
ERR.Z EBCDIC BLANK - NO - GO TU ERR 
ZERO YtS - REPLACE BLANK WITH ZERO 
ZERO IS JTEST LESS THAN AN EBCDIC 
ERR»+Z ZERO - YES - GO TO ERR 

JTEST+4032 IN ACCUMULATOR 

GET-10*GET+ ( JTEST+4032 ) /256 



CSP11600 

cspiieio 

CSP11820 
CSP11830 
CSPlld40 
CSP11650 
CSP11860 
CSP11B70 

cspnaao 

CSP11890 
CSP11900 
CSP11910 
CSP11920 
CSP11930 
CSP11940 
CSP11950 
CSP11960 
CSP11970 
CSP11980 
CSP11990 
CSP12000 
CSP12010 
CSP12020 
CSP12030 
CSP12040 
CSP12050 
CSP12060 
CSP12070 
CSP12080 
CSP1209O 
CSP12100 
CSP12110 
CSP12120 
CSP12130 
CSP12140 
CSP12150 
CSP12160 
CSP12170 
CSP12180 
CSP12190 
CSP12200 
CSP12210 
CSP12220 
CSP12230 
CSP12240 
CSP12250 
CSP1Z260 
CSP12270 
CSP12280 
CSP12290 
CSP12300 
CSP12310 
CSP12320 
CSP12330 



002F 


1808 


SRA 


0030 20 


064D6063 


LIBF 


0031 20 


058A3580 


LIBF 


0032 1 


0057 


DC 


0033 20 


054C4000 


LIBF 


0034 1 


005A 


DC 


0035 20 


05517A00 


LIBF 


0036 1 


005D 


DC 


0037 20 


15599500 


LIBF 


0038 20 


05044100 


LIBF 


0039 1 


0057 


DC 


003A 20 


058A3580 


LIBF 


003B 1 


005A 


DC 



003C 





71FF 




MDX 1 


003D 





70E6 


# 


MDX 


003E 


20 


05517A00 


LIBF 


003F 





0000 


SHIFT 


DC 


0040 


20 


15599500 




LIBF 


0041 


30 


15A56545 




CALL 


0043 





0000 


JCRD3 


DC 


0044 


1 


0000 




DC 


0045 


1 


0019 




DC 


0046 


1 


0043 


* 


DC 


0047 





C0D1 


# 


LD 


0048 





90BF 




S 


0049 


01 


4C20004C 




BSC L 


004B 


20 


22559000 




LIBF 


004C 


00 


65000000 


FIN 


LDX LI 


004E 


00 


4C000000 


D0NE1 


BSC L 


0050 





0004 


FOUR 


DC 


0051 





4040 


BLANK 


DC 


0052 





F040 


ZERO 


DC 


0053 





10A0 


ERR 


SLT 


0054 





DB7E 




STD 3 


0055 





D37D 




STO 3 


0056 





70F5 




MDX 


0057 




0003 


TEMP 


BSS 


005A 




0003 


ANS 


BSS 


005D 


84 


50000000 


ETEN 


XFLC 


0060 








END 



SHIFT 8 IS SAME AS DIVIDE BY 256 
8 NO - SHIFT 4 BIT DIGIT TO LUW 
FLOAT ORDER OF ACC AND MAKE REAL 
ESTO STORE REAL DIGIT 
TEMP IN TEMPORARY STORAGE 
ELD LOAD FAC WITH 
ANS GET 

EMPY MULTIPLY GET 
ETEN BT TEN 

NORM NORMALIZE THE PRODUCT 
EADD ADD TEMPORARY STORAGE 
TEMP TO FAC 
ESTO STORE RESULT 
ANS IN GET 

SEE IF JNOW IS LESS THAN JLAST. 

IF YES. JNOW-JNOW+1 AND GO BACK 

FOR MORE. IF NO. PLACE DECIMAL 

POINT. 
-1 DECREMENT FIELD WIDTH 
JCRD2 NOT DONE-GET NEXT DIGIT 

GET»SHIFT»GET 
EMPY DONE-MULTIPLY BY SHIFT TO PLACE 

»-* ADDRESS OF SHIFT DECIMAL PulNT 

NORM NORMALIZE THE RESULT 

REPLACE SIGN OF JCARD 
NZONE RESTORE ORIGINAL JCARD SIGN 
»-* ADDRESS OF JCARD 
GET ADDRESS OF JLAST 

JCRD1 ADDRESS OF ORIG. SIGN INDICATOR 
JCRD3 DUMMY 

IF INDICATOR EQUALS 2. 

GET—GET. OTHERWISE. EXIT 

JCRD1 LOAD OLD SIGN AND SEE IF IT 

TWO+1 WAS NEGATIVE 

FIN.Z IF YES. REVERSE SIGN-NO-EXIT 

GET— GET 
SNR REVERSE THE SIGN OF THE RESULT 

EXIT 

*-« RESTORE IR1 

*-* RETURN TO CALLING PROGRAM 

4 CONSTANT OF FOUR 

/4040 CONSTANT OF EBCDIC BLANK 

/F040 CONSTANT OF EBCDIC ZERu 

32 CLEAR ACCUMULATOR AND EXTENSION 

126 CLEAR MANTISSA OF FAC 

125 CLEAR CHARACTERISTIC UF FAC 

FIN -60 TO EXIT 

3 TEMPORARY STORAGE 

3 TEMPORARY STORAGE 

10.0 CONSTANT OF 10.0 (TEN) 
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CSP12340 
CSP12350 
CSP12360 
CSP12370 
CSP123U0 
CSP12390 
CSP12400 
CSP12410 
CSP12420 
CSP12430 
CSP12440 
CSP12450 
CSP12460 
CSP12470 
CSP12480 
CSP12490 
CSP12500 
CSP12510 
CSP12520 
CSP12530 
CSP12540 
CSP12550 
CSP12560 
CSP12570 
CSP12580 
CSP12590 
CSP12600 
CSP12610 
CSP12620 
CSP12630 
CSP12640 
CSP12650 
CSP12660 
CSP12670 
CSP12680 
CSP1269Q 
CSP12700 
CSP12710 
CSP12720 
CSP12730 
CSP12740 
CSP12750 
CSP12760 
CSP12770 
CSP12780 
CSP12790 
CSP12800 
CSP12810 
CSP12820 
CSP12830 
CSP12840 



Form H20-0241-3 
Revised 10/11/68 
By TNL N20-1888 

ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



NO ERRORS IN ABOVE ASSEMBLY. 
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Form H20-0241-3 
Revised 10/11/68 
ByTNLN20-1888 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



// DUP 
•STORE 
3371 0007 



MS UA GET 



CSP12850 
CSP12860 



// ASM 

«* ICOMP SUBROUTINE 

« NAME ICOMP 

* LIST 

0000 090D6517 



FOR 1130 COMMERCIAL SUBROUTINE PACKAGE 



(ID) 
(ID) 



0000 
0001 
0002 
0004 
0005 
0007 
0008 
0009 
000A 
000B 
000C 
000E 
000F 
0010 
0011 
0013 
0015 
0016 
0017 
0018 



0019 
00 IB 
001C 
001E 
001F 
0021 
0023 
0024 
0026 
0027 
0029 
002A 



0000 

6973 

01 65800000 
C100 

00 95800002 



D04B 

D04A 

800A 

D00F 

C103 

00 95800005 

D046 

8004 

DO 11 

00 C5800002 

00 95800001 

80FE 

4808 

COFC 

D035 



00 C4000000 

D05C 

01 4C100021 

FOOF 

01 D480001A 
00 C4000000 

D055 

01 4C100029 

F007 

01 D4800022 
7106 

694C 



002B 00 
0020 00 
002F 00 
0031 00 

0033 

0034 01 

0036 

0037 

0038 

0039 00 



C580FFFE 

9580FFFF 

9580FFFB 

8580FFFC 

80E0 

4C30004B 

F0F7 

80DA 

DOOB 

85B0FFFF. 



ICOMP DC 
STX 
LDX 
LD 
S 

STO 
STO 
A 

STO 
LD 
S 
STO 



TWO 

ONE 



STO 

LD 

S 

A 

BSC 

LD 

STO 



SGNJ LD 
STO 
BSC 
EOR 
STO 

SGNK LD 
STO 
BSC 
EOR 
STO 

CHCK MDX 
STX 



BSC 
EOR 



ICOMP ICOMP SUBROUTINE ENTRY POINT 
ICOMP (JCARD. J. JLAST .KCARD .K.KLAST) 
THE WORDS JCARD(J) THROUGH 
JCARD(JLAST) ARE COMPARED TO THE 
WORDS KCARD(K) THROUGH 
KCARD(KLAST). 
*-» ARGUMENT ADDRESS COMES IN HERE 
1 SAVE1+1 SAVE IR1 
U ICOMP PUT ARGUMENT ADDRESS IN IR1 

1 GET JCARD ADDRESS 
U 2 SUBTRACT JLAST VALUE 

JPIC1+1 STORE JCARD(JLAST) FOR JHASH 
JP1C2+1 STORE JCARDULAST) FOR ICOMP 
ONE+1 ADD CONSTANT OF ONE 
SGNJ+1 CREATE ADDRESS OF JCARDULAST) 
1 3 GET KCARD ADDRESS 
II 5 SUBTRACT KLAST VALUE 

KPIC2+1 STORE KCARD(KLAST) FOR ICOMP 
ONE+1 ADD CONSTANT OF ONE 
SGNK+1 CREATE ADDRESS OF KCARD(KLAST) 
II 2 GET VALUE OF JLAST 
U 1 SUBTRACT VALUE OF J 
ONE+1 ADD CONSTANT OF ONE 
+ CHECK FIELD WIDTH 
ONE+1 NEGATIVE OR ZERO-MAKE IT ONE 
CNTCO+1 SAVE FIELD WIDTH IN COMP CNT 
CLEAR AND SAVE THE SIGNS ON THE 
JCARD AND THE KCARD FIELDS 
L *-» PICKUP THE SIGN OF JCARD 

JSIGN SAVE IT 
L SGNKi- IS IT NEG-NO-LOOK AT KCARD 

HFFFF+1 YES-MAKE IT POSITIVE AND 
I SGNJ+1 CHANGE JCARD FIELD SIGN 
L *-» PICKUP THE SIGN OF KCARD 

KSIGN SAVE IT 
L CHCK.- IS IT NEG-NO-GO TO CHCK 
HFFFF+1 YES-MAKE IT POSITIVE AND 

I SGNK+1 CHANGE THE KCARD FIELD SIGN 
1 6 MOVE OVER SIX ARGUMENTS 

1 DONE1+1 CREATE RETURN ADDRESS 
K IS COMPARED TO 
KSTRT=KLAST+J-JLAST-1 
PICKUP THE VALUE OF K 
SUBTRACT THE VALUE OF KLAST 
SUBTRACT THE VALUE OF J 
ADD THE VALUE OF JLAST 
ONE+1 ADD CONSTANT OF ONE 
L JHASH. -Z IF POSITIVE GO TO JHASH 

HFFFF+1 OTHERWISE COMPLIMENT AND ADD 
TWO+1 ONE GIVING LEADING PART KCARD 
ZIPCT+1 STORE THIS COUNT AT ZIPCT 

II -2 ADD VALUE OF K 



II -2 

II -1 

II -5 

II -4 



CSP12870 
CSP12880 
CSP12890 
CSP12900 
CSP12910 
CSP12920 
CSP12930 
CSP12940 
CSP12950 
CSP12960 
CSP12970 
CSP12980 
CSP12990 
CSP13000 
CSP13010 
CSP13020 
CSP13030 
CSP13040 
CSP13050 
CSP13060 
CSP13070 
CSP13080 
CSP13090 
CSP13100 
CSP13110 
CSP13120 
CSP13130 
CSP13140 
CSP13150 
CSP13160 
CSP13170 
CSP13180 
CSP13190 
CSP13200 
CSP13210 
CSP13220 
CSP13230 
CSP13240 
CSP13250 
CSP13260 
CSP13270 
CSP13280 
CSP13290 
CSP13300 
CSP13310 
CSP13320 
CSP13330 
CSP13340 
CSP13350 
CSP13360 
CSP13370 
CSP13380 
CSP13390 
CSP13400 
CSP13410 
CSP13420 



-170- 



003B 


9008 






.S 




003C 


D0C3 






STO 




003D 


C1FD 






LD 


1 


003E 


9CC1 






S 




0Q3F 


0006 




» 


STO 




0040 


C038 




* 


LD 




0041 3 


FOEC 






EOR 




0042 


DOBD 




ZIPCT 


STO 




0043 00 


65000000 


LDX 


LI 


0045 00 


C5G00 


OOC 


KPIC1 


LD 


LI 



C047 01 4C30006D 



0049 
0C4A 






71FF 
70FA 


JHASH 


MCX 
VDX 


004B 
004C 






ieio 

D033 


SRA 
STO 


004D 


00 


65000000 


CNTCO 
JPIC1 

JPIC2 
KPIC2 


LDX 


004F 
0051 


OC 



8500000C 
1890 


A 
SRT 


0052 
0054 
0056 


00 
00 



C5000000 
95000000 
D0A9 


LD 

S 

STO 


0057 
C059 


01 



4C200063 
109C 


esc 

SLT 



005A 


71FF 


MDX 


005b 


70F3 


MDX 


005C 01 


4C18006D 


BSC 


005E 


C019 


LD 


005F 


F019 


EOR 


0060 01 


4C10006D 


BSC 


0062 


7004 


MDX 


0063 


C014 NEQ LD 


0064 


*014 


EOR 


0065 01 


4C100069 


BSC 



OME+1 SUBTRACT CONSTANT OF ONE 

ICOMP STORE TEMPORARILY 

-3 GET KCARD ADDRESS 

ICOMP SUBTRACT TEMPORARY VALUE GIVING 

KPIC1+1 ADDR FOR SEARCHING BEGINNING 

OF KCARD 

ICOMP=-KSIGN 
KSIGN. LOAD SIGN OF KCARD 
HrFF<y+l NEGATE IT 
ICOMP STORE IT IN ICOMP 

KNOW»K 
*-* LOAD IR1 WITH BEGINNING KCARD CT 
*-* PICKUP KCARDIKNOW) 

IS KCARDIKNOW) POSITIVE 
FIN. -2 IF POSITIVE. GO TO FIN 

SEE IF KNOW IS LESS THAN KSTRT. 

IF YES. KNO*=KNCW+l AND LOOK AT 

NEXT KCARD wORD. IF NO. GO TO 

JHA5H. 
-1 OTHERWISE. DECREMENT FIELD WIDTH 
KPIC1 NOT DONE-GO BACK FOR NEXT DIGIT 

JHASH=0 
16 DONE-CLEAR ACCUMULATOR 
ICOMP CLEAR ICOMP 

KNOW=KSTRT+l 

KSTRT=J 
»-* LOAD IR1 WITH FIELD WIDTH 

JHASH=JHASH+JCARD(KSTRT) 
*-* ADD JCARD(KSTRT) TO JHASH 
16 STORE JHASH IN EXTENSION 

ICOMP. JCARDtKSTRT) -KCARD (KNOW) 
. *-* LOAD JCARD(KSTRT) 
. *-* SUBTRACT KCARDIKNOW) 
ICOMP STORE RESULT 

IS ICOMP ZERO - NC - GO TO NECJ 
NEQ.Z IF NCT ZERO. GO TO NEQ. 
16 OTHERWISE, PUT JHASH IN ACCUM 

<NOW = KNOW-t-l 

SEE IF KSTRT IS LESS THAN JLAST. 

IF Y£S. KSTRT=KSTRT+1 AND TRY 

NEXT PAIR OF DIGITS. IF NO, 
. -1 DECREMENT FIELD WIDTH 

JPIC1 NOT DONE - GO BACK 
IF NO IS JSIGN»KSIGN*JHASH NEGATIVE. 
FI.N. + - DONE-IF JHASH IS ZERO GO FIN 
JSIGN OTHERWISE - COMPUTE JSIGN 
KSIGN TIMES KSIGN 

FIN,- IF NOT NEGATIVE. GO TO FIN 
OVR1 OTHERWISE GO TO OVR1 

IS KSIGN* JSIGN NEGATIVE 
JSIGN COMPUTE JSIGN 
KSIGN TIMES KSIGN 
OVR2,- IF NOT NEGATIVE, GO TO OVR2 



0067 





C0E5 


OVR1 


LD 


0068 





D097 


OVR2 


STO 


0069 





COOE 


LD 


006A 





1005 




SLA 


006H 





F094 




EOR 


006C 





D093 




STO 


006D 





COOA 


FIN 


-LD 


006E 


01 


D480001A 




STO I 


0070 





cooe 




LD 


0071 


01 


D4800022 




STO I 


0073 





C08C 




LD 


0074 


00 


65000000 


SAVE1 


LDX L 


0076 


00 


4C000000 


DONE1 


BSC L 


0078 





0000 


JSIGN 


DC 


0079 





0000 


KSIGN 


DC 


007A 








END 



ICOMP=l 
CNTCO OTHERWISE, SET ICOMP 
ICOMP TO A POSITIVE NUMBER 

ICOKP=JSIGN*ICOMP 
JSIGN 
5 

ICOMP 
ICOMP 

R.ESTORE SIGNS ON JCARD. KCARD FIELDS 
JSIGN RESTORE THE ORIGINAL 
SGNJ+1 SIGN OF JCARD 
KSIGN RESTORE THE ORIGINAL 
SGNK+1 SIGN OF KCARD 
ICOMP PUT ICOMP IN THE ACCUMULATOR 

EXIT 
*-* RESTORE IR1 
*-* RETURN TO CALLING PROGRAM 
*-* SIGN OF JCARD 
*-* SIGN OF KCARD 
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CSP13430 
CSP13440 
CSP13450 
CSP13460 
CSP13470 
CSP13480 
CSP13490 
CSP13500 
CSP13510 
CSP13520 
CSP13530 
CSP13540 
CSP13550 
CSP13560 
CSP13570 
CSP13580 
CSP13590 
CSP13600 
CSP1361C 
CSP13620 
CSP13630 
CSP13640 
CSP13650 
CSP13660 
CSP13670 
CSP13680 
CSP13690 
CSP13700 
CSP13710 
CSP137Z0 
CSP13730 
CSP13740 
CSP13750 
CSP13760 
CSP13770 
CSP13780 
CSP13790 
CSP13800 
CSP13810 
CSP13820 
CSP13830 
CSP13840 
CSP13850 
CSP13860 
CSP13870 
CSP13880 
CSP13890 
CSP13900 
CSP13910 
CSP13920 
CSP13930 
CSP13940 
CSP13950 
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CSP13960 
CSP13970 
CSP13980 
CSP13990 
CSP14000 
CSP14010 
CSP14020 
CSP14030 
CSP14040 
CSP14050 
CSP14060 
CSP14070 
CSP14080 
CSP14090 
CSP14100 
CSP14110 
CSP14120 
CSP14130 
CSP14140 
CSP14150 



Form H20-0241-3 
Revised 10/11/68 
ByTNLN20-1888 

ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



NO ERRORS IN ABOVE ASSEMBLY, 



// OUP 
•STORE 
3378 0006 



WS UA ICOMP 



CSPU160 
CSP14170 



-171- 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



// ASM 






•• IONO 


SUBROUTINE 


FOR 1130 cor 


• NAME 


IOND 




* LIST 






0000 


09595100 


ENT 
•CALL IOND 
•CALL IONO 
» 
IOND BSS 


0000 


0001 


0001 00 


74000032 


IOPND MDX 


0003 


70F0 


MDX 


0004 01 


4C80O000 


BACK BSC 


0006 




END 



IOND SUBROUTINE NAME 
NO PARAMETERS 

ALLOWS I/O OPERATIONS TO END BEFORE 
PAUSE OR STOP IS ENTERED 
1 ARGUMENT ADDRESS 

50i0 ANY INTERRUPTS PENDING 
IOPND YES - KEEP CHECKING 

IOND NO - RETURN TO CALLING PRG CSP14290 

CSP14300 



CSP14180 
(ID) CSP14190 
(ID) CSP14200 
CSP14210 
CSP14220 
CSP14230 
CSP14240 
CSP14250 
CSP14260 
CSP14270 
CSP14280 



NO ERRORS IN ABOVE ASSEMBLY. 



// DUP 

•STORE WS UA 

3380 0002 



CSP14310 
CSP14320 



// ASM 

•• MOVE SUBROUTINE 

• NAME MOVE 

• LIST 

0000 145A5140 



FOR 1130 COMMERCIAL SUBROUTINE PACKAGE 



(ID) 
(ID) 



0000 





0000 


0001 





691F 


0002 


01 


65800000 


0004 





C100 


0005 


00 


95800002 


0007 





D013 


0008 


00 


C5800002 


OOOA 


00 


95800001 


000C 





4826 


000D 





1810 


000E 





DOOA 


000F 





C103 


0010 


00 


95800004 


0012 





9006 


0013 





D009 


0014 


01 


74010019 


0016 





7105 


0017 





690B 



DC 
STX 
LDX 
LD 

S 
STO 

LD 

S 

BSC 

SRA 

STO 

LD 

S 

s 

STO 



MDX 
STX 



0018 00 65000000 



OOIA 00 
001C 00 


C500OO00 
D5000000 


LD1 
STO 

• 


LD 
STO 


LI 
LI 


• -« 

*-# 


001E 
001F 


71FF 
70FA 


• 

• 

SAVE1 

DONE1 


MDX 
MDX 


1 


-1 
LD1 


0020 00 
0022 00 
0024 


65000000 
4C000000 


LDX 
BSC 

END 


LI 

L 


• -• 

• -* 



MOVE MOVE SUBROUTINE ENTRY POINT 

CALL MOVE(JCARDiJ.JLAST»KCARDtK) 
THE WORDS JCARD(J) THROUGH 
JCARD(JLAST) ARE MOVED TO KCARD 
STARTING AT KCARD(K). 
•-* ARGUMENT ADDRESS COMES IN HERE 
1 SAVElfl SAVE IR1 
II MOVE PUT ARGUMENT ADDRESS IN IR1 

1 GET JCARD ADDRESS 
II 2 SUBTRACT JLAST VALUE 

LD1+1 PLACE AODR OF JCARD(JLAST) IN 
PICKUP OF MOVE 
GET JLAST VALUE 
SUBTRACT J VALUE 
CHECK FIELD WIDTH 
NEGATIVE - MAKE IT ZERO 
LDX+1 STORE FIELD WIDTH IN LDX 

3 GET KCARD ADDRESS 

4 SUBTRACT K VALUE 
LDX+1 SUBTRACT FIELD WIDTH 
ST0*1 PLACE ADDR OF KCARD(KLAST) IN 

STORE OF MOVE 
LDX+1.1 ADD ONE TO FIELD WIDTH 
MAKING IT TRUE 

5 MOVE OVER FIVE ARGUMENTS 
D0NE1+1 CREATE RETURN ADDRESS 

JNOW-J 

KNOW-K+JNOW-J 
•-• LOAD IR1 WITH FIELD WIDTH 
KCARD ( KNOW ) -JCARD ( JNOW ) 
PICKUP JCARDUNOW) 
STORE IT IN KCARD(KNOW) 
SEE IF JNOW IS LESS THAN JLAST. 
IF YESt JNOWONOW+1 AND MOVE 
NEXT CHARACTER. IF NO* EXIT.... 
DECREMENT THE FIELD WIDTH 
NOT DONE - GET NEXT WORD 

EXIT 

DONE - RESTORE IR1 
RETURN TO CALLING PROGRAM 



II 2 
II 1 

+Z 
16 

1 
II 



CSP14330 
CSP14340 
CSP14350 
CSP14360 
CSP14370 
CSP14380 
CSP1O90 
CSP14400 
CSP14410 
CSP14420 
CSP14430 
CSP14440 
CSP14450 
CSP14460 
CSP14470 
CSP14480 
CSP14490 
CSP14500 
CSP14510 
CSP14520 
CSP14530 
CSP14540 
CSP14550 
CSP14560 
CSP14570 
CSP14580 
CSP14590 
CSP14600 
CSP14610 
CSP14620 
CSP14630 
CSP14640 
CSP14650 
CSP14660 
CSP14670 
CSP14680 
CSP14690 
CSP147C0 
CSP1<»710 
CSP14720 
CSP14730 
CSP14740 
CSP14750 
CSP14760 
CSP14770 



NO ERRORS IN ABOVE ASSEMBLY. 



/• DUP 

•STORE WS UA MOVE 

3382 0003 



CSP1«780 
CSP14790 
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// ASM 

** MPY SUBROUTINE 

* NAME MPY 

* LIST 

0000 145E8000 



0000 0000 

0001 6A6A 

0002 696B 

0003 01 6580C00C 

0005 C104 

0006 . D05E 



FOR 1130 COMMERCIAL SUBROUTINE PACKAGE 



( ID) 
( ID) 



0007 
0009 

OOOA 

ooon 
oooc 

000E 
OOOF 
0010 
0011 
0012 
0014 
0016 
0017 
0018 
0019 
001A 
0013 
001C 
001D 
001E 
002C 
0021 
0022 
0023 
0024 
0025 
0026 
0027 
0029 
002B 
002C 
0020 
002E 
002F 
0030 



01 C4800065 

900B 

D0F5 

C C100 

00 95H00002 

D04E 

D075 

8004 

D02F 

00 C5800002 

00 95800001 



80FE 



COFC 

D024 

C103 

D03C 

D047 

D076 
00 95800005 
D054 
D059 
80F2 
D027 
C105 
D070 

D03F 

00 C5800005 

00 95800004 



80E9 
4808 
C0E7 
0043 
7107 
693F 



0031 COCE 

0032 00 8580FFFA 



TWO 

ONE 



DC 

STX 

STX 

LDX 

LD 

STO 

LD 

S 

STO 

LD 

S 

STO 

STO 

A 

STO 

LD 

S 

A 

BSC 

LD 

STO 

LD 

STO 

STO 

STO 

S 

STO 

STO 

A 

STO 

LD 

STO 

STO 

LD 

S 

A 

BSC 

LD 

STO 

MDX 

STX 



MPY MPY SUBROUTINE ENTRY POINT 
CALL MPY( JCARD. J. JLAST. KCARD. KiKLAST. NEK) 
THE WORDS JCARD(J) THROUGH 
JCARD(JLAST) MULTIPLY THE WORDS 
KCARD(K) THROUGH KCARD ( K.LAST ) . 
THE RESULT IS IN THE KCARD FIELD 
EXTENDED TO THE LEFT. 
*-» ARGUMENT ADDRESS COMES IN HERE 
2 SAVE2+1 SAVE IR2 
1 SAVE1+1 SAVE IR1 
II MPY PUT ARGUMENT ADDRESS IN IR1 
1 4 GET K ADDRESS 

Kl STORE FOR FILL OF ZEROES 
CALCULATE K-l 

I Kl GET VALUE OF K 

ONE + 1 SUBTRACT CONSTANT OF ONE 
MPY STORE IN MPY 
1 GET JCARD ADDRESS 

II 2 SUBTRACT JLAST VALUE 
SRCH+1 SAVE FOR JFRST SEARCH 
MULT1+1 SAVE FOR MULTIPLICATION 
ONE+1 ADD CONSTANT OF ONE 

CK+2 CREATE ADDRESS OF JCARD(JLAST) 
II 2 GET JLAST VALUE 
II 1 SUBTRACT J VALUE 

ONE+1 ADD CONSTANT OF ONE 

+ CHECK FIELD WIDTH 

ONE+1 NEGATIVE OR ZERO-MAKE IT ONE 

SCHCT+1 SAVE FIELD WIDTH FOR SEARCH 
1 3 GET KCARD ADDRESS 

KCRD1 SAVE FOR FILL 

KCRD2 SAVE FOR FILL 

KCRD3 SAVE FOR CARRY 
II 5 SUBTRACT JLAST VALUE 

PICK+1 SAVE FOR MULTIPLICATION 

PUT1+1 SAVE FOR MULTIPLICATION 

ONE+1 ADD CONSTANT OF ONE 

SGNK+1 CREATE ADDRESS OF KCARD(KLAST) 
1 5 GET KLA5T ADDRESS 

KLAS2 SAVE FOR CARRY 

KLAS1 SAVE FOR FILL 
115 GET -KLAST VALUE 
II 4 SUBTRACT K VALUE 

ONE+1 ADD CONSTANT OF ONE 

♦ CHECK FIELD WIDTH 

ONE+1 NEGATIVE OR ZERO-MAKE IT ONE 

MULTC+1 SAVE FOR MULTIPLICATION 
1 7 MOVE OVER SEVEN ARGUMENTS 
1 D0NE1+1 CREATE RETURN ADDRESS 
KSTRT=K-JLAST+J-1 

MPY LOAD K-l 
II -6 ADD VALUE OF J 



CSP14800 
CSP14810 
CSP14820 
CSP14830 
CSP14840 
CSP14850 
CSP14860 
CSP14870 
CSP14880 
CSP14890 
CSP14900 
CSP14910 
CSP14920 
CSP14930 
CSP14940 
CSP14950 
CSP14960 
CSP14970 
CSP14980 
CSP14990 
CSP15000 
CSP15010 
CSP15020 
CSP15030 
CSP15040 
CSP15050 
CSP15060 
CSP15070 
CSP15080 
CSP15090 
CSP15100 
CSP15110 
CSP15120 
CSP15130 
CSP15140 
CSP15150 
CSP15160 
CSP15170 
CSP15180 
CSP15190 
CSP15200 
CSP15210 
CSP15220 
CSP15230 
CSP15240 
CSP15250 
CSP15260 
CSP15270 
CSP15280 
CSP15290 
CSP15300 
CSP15310 
CSP15320 
CSP15330 
CSP15340 
CSP15350 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 
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ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMPI 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



0034 


00 


9580FFFB 




S 


11 


0036 


01 


4C30003D 




BSC 


L 


0038 


00 


C58CFFFE 




LD 


u 


003A 


CO 


D580FFFF 


MONE 


STO 


11 


003C 





7030 




MDX 




003D 


00 


65000000 


SCHCT 


LDX 


LI 


003F 





D0FE 


OK 


STO 




0040 


00 


C4000000 


# 


LD 


L 


0042 





D05E 




STO 




0043 


01 


4C100049 




BSC 


L 


0045 





F0F5 




EOR 




0046 


01 


D4800041 




STO 


I 


0048 





C0F2 




LD 




0049 





1890 


OVRJ 


SRT 




0C4A 


00 


C4000000 


SGNK 


LD 


L 


004C 


01 


4C100054 




BSC 


L 


004E 





F0EC 




EOR 




004F 


01 


D480004B 




STO 


I 


0051 





1090 




SLT 




0052 





F0E8 




EOR 




0053 





7001 




MDX 




0054 





1090 


KPLUS 


SLT 




0055 





D04C 


OVRK 

• 


STO 




0056 


30 


062534C0 


* 


N CALL 




0058 





0000 


KCRD1 


DC 




0059 


1 


003E 




DC 




005A 


1 


0000 




DC 




005B 


1 


00A3 


SRCH 


DC 




005C 


00 


C5000000 


LD 


LI 


005E 


01 


4C300071 




BSC 


L 



0060 71FF 

0061 70FA 



0062 30 062534C0 
0064 0000 



0065 

0066 

0067 1 



0000 
0000 
00A3 



MDX 
MDX 



CALL 
KCRD2 DC 
Kl DC 
KLAS1 DC 

DC 



0068 C038 



-5 SUBTRACT VALUE OF JLAST 

SCHCT. -Z IF KSTRT POSITIV-GO TO SCHCT 

iNER = KLAST 
-2 NOT POSITIVE-LOAD KLAST VALUE 
-1 AND STORE AT NER 
SAVE1 GO TO EXIT 

JFRST=J 
*-* LOAD IR1 WITH JCARD FIELD wIDTH 
SCHCT+1 SAVE KSTRT IN SCHCT + 1 

CLEAR AND SAVE THE SIGNS ON THE 

JCARD AND THE KCARD FIELDS 
*-* GET JCARD(JLAST) VALUE 
JSIGN SAVE SIGN IN JSIGN 
0VRJ»- IF NOT NEGATIVE-GO TO OVRJ 
MONE+1 NEGATIVE-MAKE SIGN POSITIVE 
OK + 2 AND PUT BACK IN JCARDULAST) 
MONE+1 PICKUP A MINUS ONE 
16 PUT JSIGN INDICATION IN EXTENTON 
*-* PICKUP KCARD(KLAST) 
KPLUS.- IF NOT NEGATIVE-GO TO KPLUS 
MONE+1 NEGATIVE-MAKE POSITIVE AND 
SGNK+1 PUT BACK IN KCARD(KLAST) 
16 GET JSIGN INDICATION 
MONE+1 CHANGE IT 
OVRK SKIP THE NEXT INSTRUCTION 
16 GET JSIGN INDICATION 
KSIGN SAVE SIGN FOR RESULT 

FILL LEFT EXTENSION OF KCARD 

WITH ZEROES 
FILL FILL KCARD EXTENSION WITH ZEROES 
*-* ADDRESS OF KCARD 
SCHCT+1 ADDRESS OF KSTRT 
MPY ADDRESS OF K-l 
ZIP ADDRESS OF ZERO 

IS JCARDULAST) POSITIVE 
*-» PICKUP JCARD(JFRST) 
MULTC.-Z IF POSITIVE-GO TO MULTC 

SEE IF JFRST IS LESS THAN JLAST. 

IF YES. JFRST»JFRST+1 AND GO 

BACK FOR MORE. IF NO. 

MULTIPLICATION IS BY ZERO. 
-1 NOT POSITIVE-DECREMENT IR1 
SRCH NOT DONE - GO BACK FOR MORE 

FILL WITH ZERO SINCE MULTIPLIER 

IS ZERO 
FILL DONE-MAKE ENTIRE RESULT ZERO 
*-» ADDRESS OF KCARD 
»-* ADDRESS OF K 
«-• ADDRESS OF KLAST 
ZIP ADDRESS OF ZERO 

RESTORE THE SIGN OF JCARD 

EXIT 

JSIGN PICKUP JCARD SIGN 



PAGE 2 

CSP15360 
CSP15370 
CSP15380 
CSP15390 
CSP15400 
CSP15410 
CSP15420 
CSP15430 
CSP15440 
CSP15450 
CSP15460 
CSP15470 
CSP15480 
CSP15490 
CSP15500 
CSP15510 
CSP15520 
CSP15530 
CSP15540 
CSP15550 
CSP15560 
CSP15570 
CSP15580 
CSP15590 
CSP15600 
CSP15610 
CSP15620 
CSP15630 
CSP15640 
CSP15650 
CSP15660 
CSP15670 
CSP15680 
CSP15690 
CSP15700 
CSP15710 
CSP15720 
CSP15730 
CSP15740 
CSP15750 
CSP15760 
CSP15770 
CSP15780 
CSP15790 
CSP15800 
CSP15810 
CSP15820 
CSP15830 
CSP15840 
CSP15850 
CSP15860 
CSP15870 
CSP15880 
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0069 


01 


04800041 




STO 


I 


006B 


00 


66000000 


SAVE2 


LDX 


L2 


C06D 


00 


65000000 


SAVE1 


LDX 


LI 


006F 


00 


4CO00CCC 


DOflEl 
MULTC 


BSC 


L 


0071 


CO 


66000000 


LDX 


L2 


0073 





69F1 


PICK 


STX 


1 


0074 


00 


C6000000 


LD 


L2 


0076 


01 


4C080090 




DSC 


L 


0078 


C 


DOED 




STO 




0079 


C 


1810 




SRA 




007A 


00 


D6000J00 


PUT1 
* 


STO 


L2 


007C 





6AF5 


STX 


2 


007D 





C0F4 




LD 




007E 





80E6 




A 




007F 





80BB 




A 




008C 


c 


HOFA 




A 




0C31 





C009 




STO 




0082 


01 


65800065 


] 


LDX 


11 


ooe4 


00 


C5C00000 


* 
MULT1 


LD 


LI 


0086 





AODF 




M 




0087 





1090 




SLT 




C088 


01 


S480008B 




A 


I 


008A 


JO 


D4000000 


PUT2 


STO 


L 


009C 


01 


74FF008B 


« 


MDX 


L 


008E 





71FF 


» 


MDX 


1 


008F 





70 F4 


* 


MDX 




0090 





72FF 


■» 
MO 


MDX 


2 


0091 





70E2 


* 


MDX 




0092 


30 


03C59668 


CALL 




0094 





0000 


KCRD3 


DC 




0095 


1 


003E 




DC 




0096 





0000 


KLAS2 


DC 




0097 


1 


C094 




DC 




0098 





C009 




LD 




0099 


01 


4C100068 




BSC 


L 


C09B 


01 


C480004B 




LD 


I 


009D 





F09D 




F.OR 




009E 


01 


D480004B 




STO 


I 



OK+2 AND RESTORE IT 

*-* RESTORE IR2 

*-* RESTORE IR1 

*-* RETURN TO CALLING PROGRAM 

KM = K 
*-» POSITIVE-LOAD IR2 WITH KCARD CNT 
Kl SAVE JFR5T AT Kl 

MULT=KCARD<KM> 
*-* PICKUP KCARD(KK) 
KO,+ IS IT POSITIVE-NO-GO TO MO 
KLAS1 YES-SAVE KCARD(KM) 
16 CLEA^ ACCUMULATOR 

<CARD(KM)*U 
*-* SET KCARD(KM)=0 

KNO^KM+JFRST-JLAST 
MULTC+1 GET THE VALUE 
MULTC+1 OF KM 
Kl AND ADD JFRST 
MONE+1 TO IT AND. CALCULATE 
PUT1+1 THE ADDRESS OF 
PUT2+1 KCARD(KNOw) 

JNOW=JFRST 
Kl LOAD IR1 WITH JFRST 

KCARD ( KNOW ) =MULT* JCARDI JNOW ) 

+KCARDIKNOW) 
*-» PICKUP JCARD(JNOW) 
KLAS1 MULTIPLY BY MULT 
16 RE-ALIGN THE PRODUCT 
PUT2+1 

PUT2+1.-1 MODIFY ADDR OF KCARD(KNOW) 
SEE IF JNOW IS LESS THAN JLAST. 
IF YES. JNOW=JNOW+l AND GO BACK 
FOR MORE. IF NO, CHECK KM. 

-1 DECREMENT IR1 

MULT1 NOT DONE-GO BACK FOR MORE 

SEE IF KM IS LESS THAN KLAST. 
IF YES. KM-KM+1 AND GO BACK FOR 
MORE. IF NO, RESOLVE CARRIES. 

-1 DONE-DECREMENT IR2 

PICK NOT DONE-GO BACK FOR MORE 

RESOLVE CARRIES IN THE PRODUCT 

CARRY DONE-RESOLVE CARRIES IN THE RES 

*-» ADDRESS OF KCARD 

SCHCT+1 ADDRESS OF KSTRT 

*-* ADDRESS OF KLAST 

KCRD3 DUMMY 

GENERATE THE SIGN OF THE PRODUCT 

KSIGN PICKUP THE SIGN INDICATOR 

FIN,- IF NOT NEGATIVE-ALL DONE-EXIT 

SGNK+1 NEGATIVE-PICKUP KCARD(KLAST) 

MONF+1 CHANGE THE SIGN 

SGNK+1 RESTORE KCARDIKLAST) 



PAGE 3 

CSP15890 
CSP15900 
CSP15910 
CSP15920 
C5P15930 
CSP15940 
CSP15950 
CSP15960 
CSP15970 
CSP15980 
CSP15990 
CSP16000 
CSP16010 
CSP16020 
CSP16030 
CSP16040 
CSP16050 
CSP1606U 
CSP16070 
CSP16080 
CSP16090 
CSP16100 
CSP16U0 
CSP16120 
CSP16130 
CSP16140 
CSP16150 
CSP16160 
CSP16170 
CSP16180 
CSP16190 
CSP16200 
CSP16210 
CSP16220 
CSP16230 
CSP16240 
CSP16250 
CSP16260 
CSP16270 
CSP16280 
CSP16290 
CSP16300 
CSP16310 
CSP16320 
CSP16330 
CSP16340 
CSP16350 
CSP16360 
CSP16370 
CSP16380 
CSP16390 
CSP16400 
CSP16410 



00A0 70C7 


MDX 


00A1 0000 


JSIGN DC 


00A2 OCOO 


KSIGN DC 


00A3 0000 


ZIP DC 


00A4 


END 



FIN GO TO EXIT 

*-* SIGN OF JCARD 

*-* SIGN OF PRODUCT 

CONSTANT OF ZERO 



PAGE 4 

CSP16420 
CSP16430 
CSP16440 
CSP16450 
CSP16460 



NO ERRORS IN ABOVE ASSEMBLY. 



ADD. 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



// DUP 
•STORE 
3385 000A 



CSP16470 
CSP16480 
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ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 



NSIGN 

NZONE 

PACK 

PRINT 

PUITCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



// ASM 

** NCOMP SUBROUTINE FOR 1130 COMMERCIAL SUBROUTINE PACKAGE 

« NAME NCOMP' 

* LIST 

0000 150D6517 EN' 



(10) 
(10) 



0000 
0001 
0002 
0004 
0005 
0007 
000S 
00OA 
000C 
000D 
00OE 
000F 
0010 
0012 
0013 
0014 
0016 
0017 



0000 

6925 

01 65800000 
C100 

00 95800002 

0017 

00 C5800002 

00 95800001 

4828 

1810 

DOOA 

C103 

00 95800004 

9006 

0007 

01 74010019 
7105 

6911 



NCOMP DC 
STX 
LOX 
LD 
S 

STO 
LD 

ONE S 

BSC 

SRA 

STO 

LD 

S 

S 

STO 

MDX 

MDX 

5TX 



NCOMP NCOMP SUBROUTINE ENTRY POINT 
NCOMP (JCARD. J » JLAST. KCARD. K> 
THE WORDS JCARD(J) THROUGH 
JCARD(JLAST) STARTING WITH 
JCARD(J) ARE COMPARED LOGICALLY 
TO THE FIELD STARTING AT 
KCARD(K). ALL DATA MUST BE IN 
Al FORMAT. 

«-« ARGUMENT ADDRESS COMES IN HERE 
1 SAVE1+1 SAVE IR1 
II NCOMP PUT ARGUMENT ADDRESS IN IR1 



0018 00 65000000 
001A 00 C500000U 
001C 1884 
0010 DOFB 
OUlt 00 C50O00OO 

0020 1884 

0021 90F7 

0022 01 4C200026 



0024 71FF 

0025 70F4 

0026 00 650J000J 
0028 00 4COO0000 
002A 



LDX 
LD2 



LDX 

LD 

SRT 

STO 

LD 

SRT 

S 

BSC 



MDX 
MDX 



SAVE1 LDX 

DOiMEl BSC 

END 



GET JCARD ADDRESS 

2 SUBTRACT JLAST VALUE 

LD1+1 CREATE END OF JCARD ADDRESS 

2 GET JLAST VALUE 

1 SUBTRACT J VALUE 
+2 CHECK FIELD WIDTH 

16 NEGATIVE - MAKE IT ZERO 
LDX+1 SAVE FIELD WIDTH 

3 GET KCARD ADDRESS 

4 SUBTRACT K VALUE 
LDX+1 SUBTRACT FIELD WIDTH 
LD2+1 CREATE END OF KCARD ADDRESS 
LDX+1. 1 MAKE FIELD WIDTH TRUE 

5 MOVE OVER FIVE ARGUMENTS 
D0NE1+1 CREATE RETURN ADDRESS 

JNOW=J 

KN0W*K+JN0W-J 
*-* PUT FIELD WIDTH IN IR1 
*-• PICKUP JCARDUNOW) 
4 DIVIDE BY SIXTEEN 
LDX+1 SAVE TEMPORARILY 
*-•» PICKUP KCARD(KNOW) 
4' DIVIDE dY SIXTEEN 
LDX+1 CALCUL JCARDI JNOW ) -KCARDl KNOW ) 
SAVE1.Z IS NCOMP ZERO-NO-ALL DONE 

SEE IF JNOW IS LESS THAN JLAST. 

IF YESf JNOW-JNOW+1 AND GO BACK 

FOR MORE. IF NO. EXIT. 
-1 YES-DECREMENT FIELD WIDTH 
LD2 GO BACK FOR MORE 

ALL DONE EXIT 

*-• RESTORE IR1 

•-* RETURN TO CALLING PROGRAM 



CSP16490 
CSP16500 
CSP16510 
CSP16520 
CSP16530 
CSP16540 
CSP16550 
CSP16560 
CSP16570 
CSP16580 
CSP16590 
CSP16600 
CSP16610 
CSP16620 
CSP16630 
CSP16640 
CSP16650 
CSP16660 
CSP16670 
CSP16680 
CSP16690 
CSP16700 
CSP16710 
CSP16720 
CSP16730 
CSP16740 
CSP16750 
CSP16760 
CSP16770 
CSP16780 
CSP16790 
CSP16800 
CSP16810 
CSP16820 
CSP16830 
CSP16840 
CSP16850 
CSP16860 
CSP16870 
CSP16880 
CSP16890 
CSP16900 
CSP16910 
CSP16920 
CSP16930 
CSP16940 
CSP16950 
CSP16960 
CSP16970 



NO ERRORS IN ABOVE ASSEMBLY. 



// DUP 
•STORE 
336F 0004 



WS UA NCOMP 



CSP16980 
CSP16990 



-176- 



// ASM 

** NSIGN SUBROUTINE 

* NAME NSIGN 

* LIST 

OOOO 158891D5 



FOR 1130 COMMERCIAL SUBROUTINE PACKAGE 



(ID) 
(ID) 



ENT 



0000 
0001 
0002 
000* 
0005 
0007 
0008 






01 



00 






0000 

691A 

65800000 

ClOO 

95800001 

80FE 

DOOl 


NSIGN 
ONE 


DC 

STX 

LDX 

LD 

S 

A 

STO 


1 
11 

1 
11 


0009 
OOOB 
0000 


00 
01 



C4000000 
4C10001F 
1890 


CHAR 


LD 

BSC 

SRT 


L 
L 


OOOE 
OOOF 


0. 
00 


C019 
D5800003 


* 


LD 
STO 


11 


0011 
0013 


00 
01 


C5800002 
4C280019 


* 


LD 
BSC 


11 

L 


0015 
0016 






1090 
FOU 


REV 

* 
FIN 


SLT 
EOR 




0017 
0019 
001A 


01 






D480000A 

7104 

6903 


STO 
MDX 
STX 


I 
1 
1 


001B 
001D 
001F 


00 
00 



65000000 
4C0OO0OO 
1890 


SAVE1 

D0N«;1 

PLUS 


LDX 
BSC 
SRT 


LI 

L 


0020 
0021 



00 


C0E5 
D5800003 




LD 
STO 


11 


0023 
0025 
0027 
0028 
002A 


00 
01 




C5800002 
4C300019 
70ED 
FFFF 


HFFFF 


LD 
BSC 

MDX 

DC 

END 


11 

L 



NSIGN NSIGN SUBROUTINE ENTRY POINT 
CALL NSIGNUCARD.J.NEWS.NOLDSJ 
THE SIGN OF THE DIGIT AT 
JCARDCJ) IS TESTED AND NOLDS IS 
SET. THE SIGN IS MODIFIED AS 
INDICATED BY NEWS. 

»-» ARGUMENT ADDRESS COMES IN HERE 

SAVE1+1 SAVE IR1 
II NSIGN PUT ARGUMENT ADDRESS IN IR1 

GET JCARD ADDRESS 

1 SUBTRACT J VALUE 
ONE+1 ADD CONSTANT OF ONE 
CHAR+1 CREATE JCARD(J) ADDRESS 

JTEST«JCARD(J) 
*-* PICKUP DIGIT 

PLUS.- IS JTEST NEGATIV-NO-GO TO PLUS 
16 YES-SAVE TEMPORARILY 

N0LDS--1 
HFFFF PICKUP MINUS ONE 

3 STORE IN NOLDS 
NEWS»JTEST IS COMPARED TO 2ER0 
NEWS IS COMPARED TO ZERO 

2 PICKUP NEWS 
FIN, +2 IF NEGATIVE ALL DONE 

JTEST—JTEST-1 
16 RESTORE JTEST 
HFFFF CHANGE THE SIGN 

JCARD(J)-JTEST 
CHAR+1 PUT NEW SIGN IN JCARD(J) 

4 MOVE OVER FOUR ARGUMENTS 
D0NE1+1 CREATE RETURN ADDRESS 

EXIT 

*-« RESTORE IR1 

»-* RETURN TO CALLING PROGRAM 

16 SAVE TEMPORARILY 

NOLDS-1 
ONE+1 PICKUP CONSTANT OF ONE 

3 STORE IT IN NOLDS 
NEWS*JTEST IS COMPARED TO ZERO 
NEWS IS COMPARED TO ZERO 

2 PICKUP NEWS 
FIN.-Z IF POSITIVE - ALL DONE 
REV REVERSE SIGN - GO TO REV 
/FFFF CONSTANT OF MINUS ONE 



CSP17000 
CSP17010 
CSP17020 
CSP17030 
CSP17040 
CSP17050 
CSP17060 
CSP17070 
CSP17080 
CSP17090 
CSP17100 
CSP17110 
CSP17120 
CSP17130 
CSP17140 
CSP17150 
CSP17160 
CSP17170 
CSP17180 
CSP17190 
CSP17200 
CSP17210 
CSP17220 
CSP17230 
CSP17240 
CSP17250 
CSP17260 
CSP17270 
CSP17280 
CSP17290 
CSP17300 
CSP17310 
CSP17320 
CSP17330 
CSP17340 
CSP17350 
CSP17360 
CSP17370 
CSP17380 
CSP17390 
CSP17400 
CSP17410 
CSP17420 
CSP17430 
CSP17440 
CSP17450 
CSP17460 
CSP17470 
CSP17480 



NO ERRORS IN ABOVE ASSEMBLY. 



// DUP 
•STORE 
3393 0004 



WS UA NSIGN 



CSP17490 
CSP17500 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



-177- 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZQNE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



// ASH 

»• NZONE SUBROUTINE 

« NAME NZONE 

» LIST 

0000 15A56545 



FOR 1130 COMMERCIAL SUBROUTINE PACKAGE 



(ID) 
(ID) 



0000 


0000 


NZONE 


DC 


0001 


6925 




STX 


0002 01 


65600000 




LDX 


0004 


C100 




LD 


0005 00 


95800001 


ONE 


S 


0007 


80FE 




A 


0008 


D01A 




STO 


0009 


D001 




STO 


000A 00 


C4000000 


LD1 


LD 


000C 


D0FE 




STO 


0000 01 


4C10003A 




BSC 


000F 


901B 




S 


0010 01 


4C18002E 




BSC 



0012 





C0F8 




LD 


0013 





E019 




AND 


0014 





180C 




SRA 


0015 





80F0 




A 


0016 


00 


D5800003 




STO 


0018 


00 


C5800002 




LD 


001A 





9011 




S 


001B 


01 


4C300024 




BSC 


001D 





800E 




A 


001E 


00 


95800003 




S 


0020 





100C 




SLA 


0021 





80E9 




A 


0022 


00 


D4000000 


STO 
FINIS 


STO 


0024 





7104 


MDX 


0025 





6903 




STX 


0026 


00 


65000000 


SAVE1 


LDX 


0.028 


00 


4C0000O0 


DONE1 


BSC 


002A 





6040 


MINUS 


DC 


002B 





F040 


ZERO 


DC 


002C 





0004 


FOUR 


DC 


002D 





3000 


H3000 


DC 


002E 


00 


C5800002 


TWO 


LD 


0030 





90FE 




S 



0031 01 4C200036 

0033 C0F6 

0034 01 D4800023 

0036 C0F5 

0037 00 D5800003 

0039 70EA 

003A 90EF 
003B 01 4C200049 

003D C0F1 
003E 00 D5800003 

0040 00 C5800002 

0042 90E9 

0043 01 4C200024 

0045 C0E5 

0046 01 D4800023 

0048 70D& 

0049 COFE 
004A 00 D5800003 
004C 70D7 
004E 



LD 
STO 

* 

NOT LD 
STO 
MDX 

PLUS S 

BSC 

LD 
STO 

LD 

S 

BSC 

# 

LD 
STO 
BIG MDX 
SPEC LD 
STO 
MDX 
END 



NZONE NZONE SUBROUTINE ENTRY POINT 
CALL NZONE(JCARD*J.NEWZ*NOLDZ) 
THE ZONE OF THE CHARACTER AT 
JCARD(J) IS TESTED AND NOLDZ IS 
SET. THE ZONE IS MODIFIED AS 
INDICATED BY NEWZ. 
*-* ARGUMENT ADDRESS COMES IN HERE 
1 SAVE1+1 SAVE IR1 
II NZONE PUT ARGUMENT ADDRESS IN IR1 

1 GET JCARD ADDRESS 
II 1 SUBTRACT J VALUE 

ONE+1 ADD CONSTANT OF ONE 
STO+1 CREATE JCARD(J) ADDRESS 
LD1+1 CREATE JCARD(J) ADDRESS 
JTEST-JCARDU) 
L *-* PICKUP THE CHARACTER 
LD1+1 SAVE IT TEMPORARILY 
IS JTEST NEGATIVE 
L PLUS*- IF NOT NEGATIVE-GO TO PLUS 

ZERO NEGATIVE-CHECK TO SEE IF IT IS 
L TW0.+- AN EBCDIC ZERO-YES-GO TO TWO 
N0LDZ*5+(JTEST-4096)/4096 
SHIFT 12 IS EQUIVALENT TO DIVIDE 
BY 4096 

AND 3000 IS EQUIVALENT TO 
SUBTRACT 4096 AND SHIFT 
LD1+1 NO-RELOAD JTEST 
H3000 REMOVE ALL BUT BITS 2 AND 3 
12 PUT IN LOW ORDER OF ACCUMULATOR 
ONE+1 ADD CONSTANT OF ONE 
II 3 STORE IN NOLDZ 

IS NEWZ LESS THAN FIVE 
II 2 PICKUP VALUE OF NEWZ 

FOUR AND CHECK FOR LESS THAN FIVE 
L FINIS»-Z NO-GO TO EXIT 
FOUR YES - RESTORE NEWZ 

JCARD « J ) * JTEST+4096* ( NEWZ-NOLDZ ) 
II 3 SUBTRACT NOLDZ 

12 PUT RESULT IN BITS 2 AND 3 
LD1 + 1 ADD ORIGINAL CHARACTER 
L *-* STORE BACK IN JCARD(J) 

EXIT 

1 4 MOVE OVER FOUR ARGUMENTS 
1 D0NE1+1 CREATE RETURN ADDRESS 
LI «-* RESTORE IR1 
L *-* RETURN TO CALLING PROGRAM 

/6040 CONSTANT OF EBCDIC MINUS SIGN 
/F040 CONSTANT OF EBCDIC ZERO 
4 CONSTANT OF FOUR 
/3000 CONSTANT FOR STRIPING BITS 
IS NEWZ TWO 
II 2 PICKUP VALUE OF NEWZ 
TWO+1 IS IT TWO 



CSP17510 
CSP17520 
CSP17530 
CSP17540 
CSP17550 
CSP17560 
CSP17570 
CSP17580 
CSP17590 
CSP17600 
CSP17610 
CSP17620 
CSP17630 
CSP17640 
CSP17650 
CSP17660 
CSP17670 
CSP17680 
CSP17690 
CSP17700 
CSP17710 
CSP17720 
CSP17730 
CSP17740 
CSP17750 
CSP17760 
CSP17770 
CSP17780 
CSP17790 
CSP17800 
CSP17810 
CSP17820 
CSP17830 
CSP17840 
CSP17850 
CSP17860 
CSP17870 
CSP17880 
CSP17890 
CSP17900 
CSP17910 
CSP17920 
CSP17930 
CSP17940 
CSP17950 
CSP17960 
CSP17970 
CSP17980 
CSP17990 
CSP18000 
CSP18010 
CSP18020 
CSP18030 
CSP18040 
CSP18050 
CSP18060 
CSP18070 



NOT.Z NO - GO TO NOT 

JCARD (J) "24640 
MINUS YES - SET JCARD(J) 
STO+1 EOUAL TO AN EBCDIC MINUS SIGN 

NOLDZ-4 
FOUR SET NOLDZ 
3 EQUAL TO FOUR 
FINIS GO TO EXIT 

IS JTEST AN EBCDIC MINUS SIGN 
MINUS NOT NEGATIVE - CHECK FOR EBCDIC 
SPECtZ MINUS SIGN-NO-GO TO SPEC 

NOLDZ-2 
TWO+1 YES-LOAD TWO AND STORE 
3 IT IN NOLDZ 

IS NEWZ FOUR 

2 PICKUP VALUE OF NEWZ AND 
FOUR CHECK FOR VALUE OF FOUR 
FINIStZ NO-GO TO FINIS 

JCARD (J)— 4032 
ZERO YES-LOAD EBCDIC ZERO AND 
STO+1 STORE IT AT JCARD(J) 
FINIS 60 TO EXIT 
BIG SPECIAL CHARACTER-LOAD LARGE 

3 NUMBER AND STORE AT NOLDZ 
FINIS ALL DONE - GO TO EXIT 



PAGE 2 

CSP18080 
CSP18090 
CSP18100 
CSP18U0 
CSP18120 
CSP18130 
CSP18140 
CSP18150 
CSP18160 
CSP1B170 
CSP18180 
CSP18190 
CSP18200 
CSP1B210 
CSP18220 
CSP18230 
CSP18240 
CSP18250 
CSP18260 
CSP18270 
CSP18280 
CSP18290 
CSP18300 
CSP18310 
CSP18320 
CSP18330 



NO ERRORS IN ABOVE ASSEMBLY. 



// DUP 
•STORE 
3397 0006 



WS UA NZONE 



CSP18340 
CSP18350 



■178- 



// ASM 














CSP18360 


♦* PRINT AND SKIP 


SUBROUTINES 1 


FOR 


1130 CSP 


(ID) 


CSP18370 


* NAME 1 


PRINT 










(ID) 


CSP18380 


• LIST 














CSP18390 


0041 




17649563 




ENT 




PRINT 


SUBROUTINE ENTRY POINT 


CSP18400 








* CALL PRINT 


(JCARD* J» 


JLAST . NERR3) 


CSP18410 








* PRINT JCARD(J) THROUGH JCARDt JLAST ) ON THE 


CSP18420 








* 1132 PRINTER. PUT ERROR PARAMETER IN NERR3. 


CSP18430 


0069 




224895C0 




ENT 




SKIP 


SUBROUTINE ENTRY POINT 


CSP18440 








* CALL SKIP(N) 




CSP18450 








• EXECUTE i 


CONTROL FUNCTION SPECIFIED BY INTEGER N 


CSP18460 


0000 





0001 


ONE 


DC 




1 


CONSTANT OF 1 


CSP18470 


0001 





2000 


SPACE 


DC 




/2000 


PRINT FUNCTION WITH SPACE 


CSP18480 


0002 





0000 


JCARD 


DC 




*-* 


JCARD J ADDRESS 


CSP18490 


0003 





0000 


JLAST 


DC 




«-# 


JCARD JLAST ADDRESS 


CSP18500 


0004 




003D 


AREA 


BSS 




61 


WORD COUNT & PRINT AREA 


CSP18510 


0041 





0000 


PRINT 


DC 




#-# 


ADDRESS OF 1ST ARGUMENT 


CSP18520 


0042 


20 


176558F1 


TEST 


LIBF 




PRNT1 


CALL BUSY TEST ROUTINE 


CSP18530 


0043 





0000 




DC 




/OOOO 


BUSY TEST PARAMETER 


CSP18540 


0044 





70FD 




MDX 




TEST 


REPEAT TEST IF BUSY 


CSP18550 


0045 





691A 




STX 


1 


SAVE1&1 


STORE IR1 


CSP18560 


0046 


01 


65800041 




LDX 


11 


PRINT 


LOAD 1ST ARGUMENT ADDRESS 


CSP18570 


0048 


20 


01647880 




LIBF 




ARGS 


CALL ARGS ROUTINE 


CSP1B580 


0049 


1 


0002 




DC 




JCARD 


JCARD J PICKED UP 


CSP18590 


004A 


1 


0003 




DC 




JLAST 


JCARD JLAST PICKED UP 


CSP18600 


004B 


1 


0004 




DC 




AREA 


CHARACTER COUNT PICKED UP 


CSP18610 


004C 





0078 




DC 




120 


MAX CHARACTER COUNT 


CSP18620 


0040 





C0B6 




LD 




AREA 


GET CHARACTER COUNT 


CSP18630 


004E 





80B1 




A 




ONE 


HALF ADJUST 


CSP18640 


004F 





1801 




SRA 




1 


DIVIDE BY TWO 


CSP18650 


0050 





DOBS 




STO 




AREA 


STORE WORD COUNT 


CSP18660 


0051 





C103 




LD 


1 


3 


GET ERROR WORD ADDRESS 


CSP18670 


0052 





D012 




STO 




ERR&l 


STORE IT IN ERROR ROUTINE 


CSP186B0 


0053 


20 


195C10D2 




LIBF 




RPACK 


CALL REVERSE PACK ROUTINE 


CSP18690 


0054 


1 


0002 




DC 




JCARD 


JCARD J ADDRESS 


CSP18700 


0055 


1 


0003 




DC 




JLAST 


JCARD JLAST ADDRESS 


CSP18710 


0056 


1 


0005 




DC 




AREA&l 


PACK INTO I/O AREA 


CSP1B720 


0057 


20 


176558F1 




LIBF 




PRNT1 


CALL PRINT ROUTINE 


CSP18730 


0058 





2000 


WRITE 


DC 




/2000 


PRINT PARAMETER 


CSP18740 


0059 


1 


0004 




DC 




AREA 


I/O AREA BUFFER 


CSP18750 


005A 


1 


0063 




DC 




ERROR 


ERROR PARAMETER 


CSP18760 


005B 





C0A5 




LD 




SPACE 


LOAD PRINT WITH SPACE 


CSP18770 


005C 





OOFB 




STO 




WRITE 


STORE IN PRINT PARAMETER 


CSP18780 


005D 





7104 




MDX 


1 


4 


INCREMENT OVER 4 ARGUMENTS 


CSP18790 


005E 





6903 




STX 


1 


D0NE1&1 


STORE IR1 


CSP18800 


005F 


00 


65000000 


SAVEl 


LDX 


LI 


#-* 


RELOAD OR RESTORE IR1 


CSP18810 


0061 


00 


4C000000 


D0NE1 


BSC 


L 


»-* 


RETURN TO CALLING PROGRAM 


CSP18820 


0063 





0000 


ERROR 


DC 




*-# 


RETURN ADDRESS GOES HERE 


CSP18830 


0064 


00 


04000000 


ERR 


STO 


L 


#-# 


STORE ACC IN ERROR PARAM 


CSP18840 


0066 





1810 




SRA 




16 


CLEAR ACC 


CSP18850 


0067 


01 


4C800063 




BSC 


I 


ERROR 


RETURN TO PRNT1 PROGRAM 


CSP18860 


0069 





0000 


SKIP 


DC 




#-# 


ADDRESS OF ARGUMENT ADDR 


CSP18870 


006A 


01 


C4800069 




LD 


I 


SKIP 


GET ARGUMENT ADDRESS 


CSP18880 


006C 





D001 




STO 




ARG&l 


DROP IT AND 


CSP18890 


006D 


00 


C4000000 


ARG 


LD 


L 


•»-# 


GET ARGUMENT 


CSP18900 


006F 


01 


4C300074 




BSC 


L 


NOSUP»-Z 


GO TO NOSUPPRESSION IF & 


CSP18910 


0071 





C009 




LD 




NOSPC 


SET UP SPACE SUPPRESSION 


CSP18920 



0072 


D0E5 




STO 


WRITE 


0073 


7003 




MDX 


DONE 


0074 


D001 


NOSUP 


STO 


CNTRL 


0075 20 


176558F1 




LIBF 


PRNT1 


0076 


3000 


CNTRL 


DC 


/3000 


0077 01 


74010069 


DONE 


MDX L 


SKIP.l 


0079 01 


4C800069 




BSC I 


SKIP 


007B 


2010 


NOSPC 


DC 


/2010 


007C 






END 





CHANGE PRINT FUNCTION 
GO TO RETURN 
SET UP COMMAND 
CALL THE PRNT ROUTINE 
CARRIAGE COMMAND WORD 
ADJUST RETURN ADDRESS 
RETURN TO CALLING PROGRAM 
SUPPRESS SPACE COMMAND 
END OF PRINT SUBPROGRAM 



PAGE 2 

CSP18930 
CSP18940 
CSP18950 
CSP18960 
CSP18970 
CSP18980 
CSP18990 
CSP19000 
CSP19010 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



NO ERRORS IN ABOVE ASSEMBLY. 



// DUP 
•STORE 
3390 0005 



WS UA PRINT 



CSP19020 
CSP19030 



■179- 



\ ADD 
A1A3 
A1DEC 
3A1 
)ARRY 
IECA1 
DIV 

D\PACK 
DUNPK 
EDIT 
FILL 
GET 
ICOMP 
IOND 
KEYBD 
MOVE 
MPY 
NCOMP 
NSIGN 
NZONE 
PACK 
PRINT 
PUNCH 
PUT 
P1403 
P1442 
READ 
R2501 
SKIP 
STACK 
SUB 
S1403 
TYPER 
UNPAC 
WHOLE 



// A« 


>M 












CSP19040 


*« PUT : 


SUBROUTINE 


FOR 1130 COMMERCIAL SUBROUTINE PACKAGE (ID) 


CSP19050 


* NAME 1 


BUT 








(ID) 


CSP19060 


* LIST 












CSP19070 


0000 




17923000 


* 
» 
* 

* 
* 


ENT 




PUT PUT SUBROUTINE ENTRY POINT 

CALL PUT (JCARD* J. JLAST. VAR. ADJST. N) 
THE REAL NUMBER VAR IS HALF- 
ADJUSTED WITH ADJST AND 
TRUNCATED. THEN DIGITS ARE 
CONVERTED FROM REAL TO EBCDIC 
AND PLACED IN THE JCARD FIELD 
FROM JCARD(JLAST) TO JCARDCJ). 


CSP19080 
CSP19090 
CSP19100 
CSP19110 
CSP19120 
CSP19130 
CSP19140 
CSP19150 


0000 





0000 


PUT 


DC 




»-* ARGUMENT ADDRESS COMES IN HERE 


CSP19160 


0001 





6957 




STX 


1 


FIN+1 SAVE IR1 


CSP19170 


0002 


01 


65800000 




LDX 


11 


PUT PUT ARGUMENT ADDRESS IN IR1 


CSP19180 


0004 





C100 




LD 


1 


GET JCARD ADDRESS 


CSP19190 


0005 





D04E 




STO 




JCRD1 SAVE FOR NZONE SUBROUTINE 


CSP19200 


0006 


00 


95800002 




S 


11 


2 SUBTRACT JLAST VALUE 


CSP19210 


0008 





800E 




A 




ONE+1 ADD CONSTANT OF ONE 


CSP19220 


0009 





003D 




STO 




PUT1+1 CREATE JCARDt JLAST) ADDRESS 


CSP19230 


000A 





C103 




LD 


1 


3 GET VAR ADDRESS 


CSP19240 


000B 





D014 




STO 




VAR SAVE FOR PICKUP 


CSP19250 


oooc 





800A 




A 




ONE+1 ADD CONSTANT OF ONE 


CSP19260 


0000 





D041 




STO 




SIGN+1 SAVE SIGN POSITION ADDRESS 


CSP19270 


000E 





C104 




LD 


1 


4 GET ADJST ADDRESS 


CSP19280 


000F 





0012 




STO 




ADJST AND SAVE 


CSP19290 


0010 


00 


C5800005 




LD 


11 


5 GET N VALUE AND 


CSP19300 


0012 





D017 




STO 




ADRN2+1 SAVE FOR TRUNCATION 


CSP19310 


0013 


00 


C5800002 


TWO 


LD 


11 


2 GET JLAST VALUE AND 


CSP19320 


0015 





D024 




STO 




JLAST SAVE IT AT JLAST 


CSP19330 


0016 


00 


95800001 


ONE 


S 


11 


1 SUBTRACT J VALUE 


CSP19340 


0018 





80FE 




A 




ONE+1 ADD CONSTANT OF ONE 


CSP19350 


0019 





4808 




BSC 




+ CHECK FIELD WIDTH 


CSP19360 


001A 





COFC 




LD 




ONE+1 NEGATIVE OR ZERO-MAKE IT ONE 


CSP19370 


001B 





0017 




STO 




PUTCT+1 OK-SAVE FIELD WIDTH 


CSP19380 


001C 





7106 




MDX 


1 


6 MOVE OVER SIX ARGUMENTS 


CSP19390 


001D 





693D 


* 


STX 


1 


DONE1+1 CREATE RETURN ADDRESS 

D I GS" WHOLE ( ABS ( VAR ) +ADJST ) 


CSP19400 
CSP19410 


001E 


30 


05042880 




CALL 




EABS TAKE THE ABSOLUTE VALUE 


CSP19420 


0020 





0000 


VAR 


DC 




«-* OF VAR 


CSP19430 


0021 


20 


05044100 




LIBF 




EADD ADD TO IT THE 


CSP19440 


0022 





0000 


ADJST 


DC 




*-* HALF-ADJUSTMENT VALUE 


CSP19450 


0023 


30 


262164C5 




CALL 




WHOLE TRUNCATE ANY FRACTION 


CSP19460 


0025 





F040 


ZERO 

* 


DC 




/F040 CONSTANT OF EBCDIC ZERO 
IS N GREATER THAN ZERO 


CSP19470 
CSP19480 


0026 





C003 




LD 




ADRN2+1 CHECK TO SEE IF N IS GREATER 


CSP19490 


0027 


01 


4C080032 


« 


BSC 


L 


PUTCT»+ THAN ZERO-NO-GO TO PUTCT 
JNOW-1 


CSP19500 
CSP19510 


0029 


00 


65000000 


ADRN2 


LDX 


LI 


*-« YES-PUT VALUE OF N IN IR1 


CSP19520 


002B 


20 


05517AO0 


AGAIN 


LIBF 




EMPY MULTIPLY BY 


CSP19530 


002C 


1 


005C 




DC 




PNT1 ONE TENTH 


CSP19540 


0020 


30 


262164C5 




CALL 




WHOLE TRUNCATE THE FRACTION 


CSP19550 


002F 





0000 


* 

• 
• 


DC 




DUMMY 

SEE IF JNOW IS LESS THAN N. 
IF YESi JNOW-JNOW+1 AND GO BACK 
FOR MORE. IF NO. START 
CONVERTING. 


CSP19560 
CSP19570 
CSP19580 
CSP19590 
CSP19600 



■180- 



0030 


71FF 




MDX 


0031 


70F9 


* 
PUTCT 


MOX 


0032 00 


65000000 


LDX 


0034 20 


058A3580 


BACK 


LIBF 


0035 1 


0062 




DC 


0036 20 


05517A00 




LIBF 


0037 1 


005C 




DC 


0038 30 


262164C5 




CALL 


003A 


0000 


JLAST 


DC 


003B 20 


058A3580 




LIBF 


003C 1 


0065 




DC 



003D 
003E 
003F 
0040 
0041 
0042 
0043 
0044 
0045 
0046 
0048 
0049 



20 05517A00 
1 005F 
20 15599500 
20 22559000 
20 05044100 
1 0062 
20 091899C0 
1008 
E8DF 

00 D4000000 
20 054C4000 

1 0065 



004A 01 74010047 
004C 71FF 
004D 70E6 

004E 00 C4000000 
0050 01 4C100058 
0052 30 15A56545 

0054 0000 

0055 1 003A 

0056 1 0014 

0057 1 0054 

0058 00 65000000 
005A 00 4C000000 
005C 7D 66666666 
005F 84 50000000 
0062 0003 
0065 0003 
0068 



LIBF 
DC 

LIBF 
LIBF 
LIBF 
DC 

LIBF 
SLA 
OR 
PUT1 STO 
LIBF 
DC 



MDX 
MDX 
MDX 
« 

SIGN LD 
BSC 
CALL 
JCRD1 DC 
DC 
DC 
DC 
* 

FIN LDX 
D0NE1 BSC 
PNT1 XFLC 
ETEN XFLC 
DIGS BSS 
DIGS1 BSS 
END 



-1 DECREMENT N BY ONE 

AGAIN NOT DONE-GO BACK FOR MORE 

JNOW-JLAST 
•-* DONE-PUT FIELD WIDTH IN IR1 
ESTO STORE FAC 
DIGS IN DIGS 

DIGT«WHOLE( DIGS/10.0) 
EMPY MULTIPLY BY 
PNT1 ONE TENTH AND 
WHOLE TRUNCATE ANY FRACTION 
*-* JLAST VALUE 
ESTO STORE RESULT IN 
DIGS1 DIGS1-SAME AS DIGT 

JCARDUNOW)«256»IFIX(DIGS 

- !0.0*DIGT)-<»032 

MULTIPLY BY 256 IS SAME AS SHIFT 

EIGHT 

SUBTRACT 4032 IS SAME AS OR F040 
EMPY MULTIPLY DIGT BY 
ETEN TEN AND 

NORM NORMALIZE THE RESULT 
SNR REVERSE THE SIGN 
EADD AND ADD IN THE 
DIGS VALUE OF DIGS 
IFIX FIX THE RESULT 
8 AND PLACE IN BITS 4-7 
ZERO MAKE AN Al CHARACTER 
*-* AND STORE IN JCARDUNOW) 
ELD SET FAC EQUAL 
DIGS1 TO DIGS1 

SEE IF JNOW IS GREATER THAN J. 

IF YES* JNOWJNOW-1 AND GO BACK 

FOR MORE. IF NO* SET ZONE. 
PUTl+ltl CHANGE JCARO ADDRESS 
Tl DECREMENT COUNT 
BACK NOT DONE-GO BACK FOR MORE 

IS VAR LESS THAN ZERO 
*-» DONE-PICKUP ORIGINAL SIGN 
FIN,- IF NOT NEG-ALL DONE-GO TO EXIT 
NZONE CALL NZONE FOR ZONE SETTING 
*-* ADDRESS OF JCARD 
JLAST ADDRESS OF JLAST 
TWO+1 ADDRESS OF NEW ZONE INDICATOR 
JCRD1 DUMMY 

EXIT 

*-• RESTORE IR1 

*-* RETURN TO CALLING PROGRAM 

0.1 CONSTANT OF ONE TENTH 

10.0 CONSTANT OF TEN POINT ZERO 

3 TEMPORARY AREA FOR GETTING A DGT 

3 TEMPORARY AREA FOR GETTING A DGT 
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CSP19610 
CSP19620 
CSP19630 
CSP19640 
CSP19650 
CSP19660 
CSP19670 
CSP19680 
CSP19690 
CSP19700 
CSP19710 
CSP19720 
CSP19730 
CSP19740 
CSP19750 
CSP19760 
CSP19770 
CSP19780 
CSP19790 
CSP19800 
CSP19810 
CSP19820 
CSP19830 
CSP19840 
CSP19850 
CSP19860 
CSP19870 
CSP19880 
CSP19890 
CSP19900 
CSP19910 
CSP19920 
CSP19930 
CSP19940 
CSP19950 
CSP19960 
CSP19970 
CSP19980 
CSP19990 
CSP20000 
CSP20010 
CSP20020 
CSP2003O 
CSP20040 
CSP20050 
CSP20060 
CSP20070 
CSP20080 
CSP20090 
CSP20100 
CSP20110 
CSP20120 



NO ERRORS IN ABOVE ASSEMBLY. 



// DUP 

•STORE WS UA PUT 

33A2 0007 



CSP20130 
CSP20140 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



-181- 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



// ASM 














CSP2015O 


•« PRINT AND SKIP 


SUBROUTINES FOR 


1130 CSP» 


1403 (ID) 


CSP2016O 


• NAME 1 


P1403 










(ID) 


CSP20170 


» LIST 














CSP20180 


0041 




17C74C33 




ENT 




P1403 


SUBROUTINE ENTRY POINT 


CSP20190 








* CALL P1403 


(JCARD. J. 


JLAST. NERR3) 


CSP20200 








# PRINT JCARD(J) THROUGH JCARD(JLAST) ON THE 


CSP20210 








• 1403 PRINTER. PUT ERROR PARAMETER IN NERR3. 


CSP20220 


0072 




22C74C33 




ENT 




S1403 


SUBROUTINE ENTRY POINT 


CSP20230 








* CALL S1403(N) 




CSP20240 








* EXECUTE CONTROL FUNCTION SPECIFIED BY INTEGER N 


CSP20250 


0000 





0001 


ONE 


DC 




1 


CONSTANT OF 1 


CSP20260 


0001 





2000 


SPACE 


DC 




/2000 


PRINT FUNCTION WITH SPACE 


CSP20270 


0002 





0000 


JCA«!D 


DC 




*-* 


JCARD J ADDRESS 


CSP20280 


0003 





0000 


JLAST 


DC 




«-« 


JCARD JLAST ADDRESS 


CSP20290 


0004 




003D 


AREA 


BSS 




61 


WORD COUNT & PRINT AREA 


CSP20300 


0041 





0000 


P1403 


DC 




*-« 


ADDRESS OF 1ST ARGUMENT 


CSP20310 


0042 





6926 




STX 


1 


SAVE1&1 


STORE IR1 


CSP20320 


0043 


01 


65800041 




LDX 


11 


P1403 


LOAD 1ST ARGUMENT ADDRESS 


CSP20330 


0045 


20 


01647880 




LIBF 




ARCS 


CALL ARGS ROUTINE 


CSP20340 


0046 


1 


0002 




DC 




JCARD 


JCARD J PICKED UP 


CSP20350 


0047 


1 


0003 




DC 




JLAST 


JCARD JLAST PICKED UP 


CSP20360 


0048 


1 


0004 




DC 




AREA 


CHARACTER COUNT PICKED UP 


CSP20370 


0049 





0078 




DC 




120 


MAX CHARACTER COUNT 


CSP20380 


004A 





C0B9 




LD 




AREA 


GET CHARACTER COUNT 


CSP20390 


004B 





80B4 




A 




ONE 


HALF ADJUST 


CSP20400 


004C 





1801 




SRA 




1 


DIVIDE BY TWO 


CSP20410 


0040 





00B6 




STO 




AREA 


STORE WORD COUNT 


CSP20420 


004E 





1001 




SLA 




1 


DOUBLE IT ■ CHARACTER 


CSP20430 


004F 





D00A 




STO 




CNT 


COUNT AND STORE COUNT 


CSP20440 


0050 





C103 




LD 


1 


3 


GET ERROR WORD ADDRESS 


CSP20450 


0051 





D01C 




STO 




ERR&l 


STORE IT IN ERROR ROUTINE 


CSP20460 


0052 


20 


195C10D2 




LIBF 




RPACK 


CALL REVERSE PACK ROUTINE 


CSP20470 


0053 


1 


0002 




DC 




JCARD 


JCARD J ADDRESS 


CSP20480 


0054 


1 


0003 




DC 




JLAST 


JCARD JLAST ADDRESS 


CSP20490 


0055 


1 


0005 




DC 




AREA&l 


PACK INTO I/O AREA 


CSP20500 


0056 


20 


292570D6 




LIBF 




ZIPCO 


CALL CONVERSION ROUTINE 


CSP20510 


0057 





0000 




DC 




/OOOO 


FROM EBCDIC TO 1403 CODES 


CSP20520 


0058 


1 


0005 




DC 




AREA+1 


FROM I/O AREA 


CSP20530 


0059 


1 


0005 




DC 




AREA+1 


TO I/O AREA 


CSP20540 


005A 





0000 


CNT 


DC 




*-* 


CHARACTER COUNT 


CSP20550 


005B 


30 


050978F3 




CALL 




EBPT3 


CONVERSION TABLE FOR ZIPCO 


CSP20560 


005D 


20 


176558F3 


TEST 


LIBF 




PRNT3 


CALL BUSY TEST ROUTINE 


CSP20570 


005E 





0000 




DC 




/0000 


BUSY TEST PARAMETER 


CSP20580 


005F 





70FD 




MDX 




TEST 


REPEAT TEST IF BUSY 


CSP20590 


0060 


20 


176558F3 




LIBF 




PRNT3 


CALL PRINT ROUTINE 


CSP20600 


0061 





2000 


WRITE 


DC 




/2000 


PRINT PARAMETER 


CSP20610 


0062 


1 


0004 




DC 




AREA 


I/O AREA BUFFER 


CSP20620 


0063 


1 


006C 




DC 




ERROR 


ERROR PARAMETER 


CSP20630 


0064 





C09C 




LD 




SPACE 


LOAD PRINT WITH SPACE 


CSP20640 


0065 





D0FB 




STO 




WRITE 


STORE IN PRINT PARAMETER 


CSP20650 


0066 





7104 




MDX 


1 


4 


INCREMENT OVER 4 ARGUMENTS 


CSP20660 


0067 





6903 




STX 


1 


DONE1&1 


STORE IR1 


CSP20670 


0068 


00 


65000000 


SAVE1 


LDX 


LI 


♦-« 


RELOAD OR RESTORE IR1 


CSP20680 


006A 


00 


4C000000 


D0NE1 


BSC 


L 


#-# 


RETURN TO CALLING PROGRAM 


CSP20690 


006C 





0000 


ERROR 


DC 




*-* 


RETURN ADDRESS GOES HERE 


CSP20700 


006D 


00 


D4000000 


ERR 


STO 


L 


#-# 


STORE ACC IN ERROR PARAM 


CSP20710 



006F 


1810 




SRA 




16 


0070 01 


4C80006C 




BSC 


I 


ERROR 


0072 


0000 


S1403 


DC 




*-# 


0073 01 


C4800072 




LD 


I 


S1403 


0075 


D001 




STO 




ARG&l 


0076 00 


C4000000 


ARG 


LD 


L 


*-» 


0078 01 


4C30007D 




BSC 


L 


NOSUP. -Z 


0O7A 


C009 




LD 




NOSPC 


007B 


D0E5 




STO 




WRITE 


007C 


7003 




MDX 




DONE 


007D 


D001 


NOSUP 


STO 




CNTRL 


007E 20 


176558F3 




LIBF 




PRNT3 


007F 


3000 


CNTRL 


DC 




/3000 


0080 01 


74010072 


DONE 


MDX 


L 


S1403.1 


0082 01 


4C800072 




BSC 


I 


S1403 


0084 


2010 


NOSPC 


DC 




/2010 


0086 






END 
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CLEAR ACC CSP20720 

RETURN TO PRNT3 PROGRAM CSP20730 

ADDRESS OF ARGUMENT ADDR CSP20740 

GET ARGUMENT ADDRESS CSP20750 

DROP IT AND CSP20760 

GET ARGUMENT CSP20770 

GO TO NOSUPPRESSION IF & CSP20780 

SET UP SPACE SUPPRESSION CSP20790 

CHANGE PRINT FUNCTION CSP20800 

GO TO RETURN CSP20810 

SET UP COMMAND CSP20820 

CALL THE PRNT3 ROUTINE CSP20830 

CARRIAGE COMMAND WORD CSP20840 

ADJUST RETURN ADDRESS CSP20850 

RETURN TO CALLING PROGRAM CSP20860 

SUPPRESS SPACE COMMAND CSP20870 

END OF P1403 SUBPROGRAM CSP20880 



NO ERRORS IN ABOVE ASSEMBLY. 



// DUP 
•STORE 
33A9 0006 



WS UA P1403 



CSP20890 
CSP20900 



-182- 



// ASM 














*• PUNCH SUBROUTINE 


FOR 1130 CSP. 


1442-5 


(ID) 


« NAME 1 


P1442 










(ID) 


* LIST 














0053 




17C74D32 




ENT 




P1442 


SUBROUTINE ENTRY POINT 








* CALL P1442 


( JCARD i J 


• JLAST* NERR2) 








« PUNCH JCARO(J> THROUGH JCARDULAST) INTO THE 








* BEGINNING OF A CARD. 


PUT ERROR PARAMETER INTO 








* NERR2. 








0000 





0000 


JCARD 


DC 




«-« 


JCARD J ADDRESS 


0001 




0051 


ARE*\ 


BSS 




81 


I/O AREA BUFFER 


0052 





0000 


FLAG 


DC 




*-# 


ERROR INDICATOR 


0053 





0000 


P1442 


DC 




*-• 


FIRST ARGUMENT ADDRESS 


0054 





6922 




STX 


1 


SAVE161 


SAVE IR1 


0055 


01 


65800053 




LDX 


11 


P1442 


LOAD 1ST ARGUMENT ADDRESS 


0057 


20 


01647860 




LIBF 




ARGS 


CALL ARGS SUBPROGRAM 


0056 


1 


0000 




DC 




JCARD 


GET JCARD(J) ADDRESS 


0059 


1 


0067 




DC 




JLAS2 


GET JCARDt JLAST) ADDRESS 


005A 


1 


0001 




DC 




AREA 


GET CHARACTER COUNT 


005B 





0050 




DC 




80 


MAX CHARACTER COUNT 


005C 





C0A4 




LD 




AREA 


DISTRIBUTE COUNT 


005D 





DOOB 




STO 




CNT2 


INTO CNT2 


005E 





C103 




LD 


1 


3 


GET ERROR WORD ADDRESS 


005F 





D01C 




STO 




ERR+1 


STORE INSIDE ERROR ROUTINE 


0060 





1810 




SRA 




16 


CLEAR ACC 


0061 





DOFO 




STO 




FLAG 


CLEAR ERROR INDICATOR 


0062 


20 


22989547 




LIBF 




SWING 


CALL REVERSE ARRAY 


0063 


1 


0000 




DC 




JCARD 


FROM JCARD J 


0064 


1 


0067 




DC 




JLAS2 


TO JCARD JLAST 


0065 


20 


225C5144 




LIBF 




SPEED 


CALL CONVERSION ROUTINE 


0066 





0011 




DC 




/0011 


FROM EBCDIC TO CARD CODE 


0067 





0000 


JLAS2 


DC 




«-« 


FROM JCARD JLAST 


0068 


1 


0002 




DC 




AREA&l 


TO THE I/O AREA BUFFER 


0069 





0000 


CNT2 


DC 




*-# 


CHARACTER COUNT 


006A 


20 


17543231 




LIBF 




PNCH1 


CALL PUNCH ROUTINE 


006B 





2000 




DC 




/2000 


PUNCH 


006C 


1 


0001 




DC 




AREA 


I/O AREA BUFFER 


006D 


1 


007A 




DC 




ERROR 


ERROR PARAMETER 


006E 


20 


22989547 




LIBF 




SWING 


REVERSE THE ARRAY 


006F 


1 


0000 




DC 




JCARD 


FROM JCARD(J) 


0070 


1 


0067 




DC 




JLAS2 


TOJCARDC JLAST) 


0071 


20 


17543231 


TEST 


LIBF 




PNCH1 


CALL BUSY TEST ROUTINE 


0072 





0000 




DC 




/0000 


BUSY TEST PARAMETER 


0073 





70FO 




MDX 




TEST 


REPEAT IF BUSY 


0074 





7104 




MDX 


1 


4 


INCREMENT 4 ARGUMENTS 


0075 





6903 




STX 


1 


DONE+1 


STORE IR1 


0076 


00 


65000000 


SAVE1 


LDX 


LI 


»-# 


RESTORE IR1 


0078 


00 


4COOOOO0 


DONE 


BSC 


L 


#-# 


RETURN TO CALLING PROGRAM 


007A 





0000 


ERROR 


DC 




•-» 


START OF ERROR ROUTINE 


007B 


00 


D4000000 


ERR 


STO 


L 


*-« 


STORE ACC IN ERROR WORD 


007D 


01 


74010052 




MDX 


L 


FLAG.l 


SET THE FLAG INDICATOR 


007F 


01 


4C80007A 




BSC 


I 


ERROR 


RETURN TO INTERRUPT PROGRM 


0082 








END 






END OF P1442 SUBPROGRAM 



CSP20910 
CSP20920 
CSP20930 
CSP20940 
CSP20950 
CSP20960 
CSP20970 
CSP20980 
CSP20990 
CSP21000 
CSP21010 
CSP21020 
CSP21030 
CSP21040 
CSP21050 
CSP21060 
CSP21070 
CSP21080 
CSP21090 
CSP21100 
CSP2U10 
CSP21120 
CSP21130 
CSP21140 
CSP21150 
CSP21160 
CSP21170 
CSP21180 
CSP21190 
CSP21200 
CSP21210 
CSP21220 
CSP21230 
CSP21240 
CSP21250 
CSP21260 
CSP21270 
CSP21280 
CSP21290 
CSP21300 
CSP21310 
CSP21320 
CSP21330 
CSP21340 
CSP21350 
CSP21360 
CSP21370 
CSP21380 
CSP21390 
CSP21400 
CSP21410 
CSP21420 
CSP21430 



NO ERRORS IN ABOVE ASSEMBLY. 



// DUP 
♦STORE 
33AF 0004 



WS UA P1442 



CSP21440 
CSP21450 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1443 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



183- 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ CC 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



// ASM 

*• READ AND PUNCH 

« NAME READ 

* LIST 

0053 19141100 



SUBROUTINES FOR 1130 CSP 



(ID) 
(ID) 



0000 





0000 


JCARD 


DC 


«-* 


0001 




0051 


AREA 


BSS 


SI 


0052 





0000 


FLAG 


DC 


#-# 


0053 





0000 


OREAD 


DC 


»-* 


0054 





691B 




STX 


1 SAVElfrl 


0055 


01 


65800053 




LDX 


UCREAD 


0057 





4022 




BSI 


SETUP 


0056 


20 


03059131 




LIBF 


CARD1 


0059 





1000 




DC 


/1000 


005A 


1 


0001 




DC 


AREA 


005B 


1 


0073 




DC 


ERROR 


005C 


20 


225C5144 


CONVT 


LIBF 


SPEED 


005D 





0010 




DC 


/0010 


005E 


1 


0002 




DC 


AREA&l 


005F 





0000 


JLAS1 


DC 


*-« 


0060 





0000 


CNT1 


DC 


#-# 


0061 





C0F0 




LD 


FLAG 


0062 


01 


4C180067 




BSC 


L FINAL**- 


0064 





1810 




SRA 


16 


0065 





00EC 




STO 


FLAG 


0066 





70F5 


CO: l 


MDX 


CONVT 


0067 


20 


22989547 


FINAL 


.LIBF 


SWING 


0068 


1 


0000 




DC 


JCARD 


0069 


1 


005F 




DC 


JLAS1 


006A 


20 


03059131 


TEST 


LIBF 


CARD1 


006B 





0000 




DC 


/OOOO 


006C 





70FD 




MDX 


TEST 


006D 





7104 




MDX 


1 A 


006E 





6903 




STX 


1 DONEfrl 


006F 


00 


65000000 


SAVE1 


LDX 


LI «-» 


0071 


00 


4C000000 


DONE 


BSC 


L #-* 


0073 





0000 


ERROR 


DC 


#-# 


0074 


00 


D4000000 


ERR 


STO 


L #-* 


0076 


01 


74010052 




MDX 


L FLAG.l 


0078 


01 


4C800073 




BSC 


I ERROR 


007A 





0000 


SETUP 


DC ., 


«-# 


007B 


20 


01647880 


W- ' 


i LIBF 


ARGS 


007C 


1 


0000 


DC 


JCARD 


0070 


1 


005F 




DC 


JLAS1 


007E 


1 


0001 




DC 


AREA 


007F 





0050 




DC 


80 


0080 





CODE 




LD 


JLAS1 


0081 





D014 




STO 


JLAS2 



ENT CREAD SUBROUTINE ENTRY POINT 
CALL READ (JCARD* J» JLAST. NERR1 J 
READ COLUMNS FROM BEGINNING OF CARD INTO JCARD(J) 
THROUGH JCARDI JLAST). PUT ERROR PARAMETER IN 
NERR1. 

ENT PUNCH SUBROUTINE ENTRY POINT 
CALL PUNCH ( JCARD t J* JLAST » NERR2) 
PUNCH JCARD(J) THROUGH JCARD (JLAST) INTO THE 
BEGINNING OF A CARD. PUT ERROR PARAMETER INTO 
NERR2. 

JCARD J ADDRESS 

I/O AREA BUFFER 

ERROR INDICATOR 

FIRST ARGUMENT ADDRESS 

SAVE IR1 

GET 1ST ARGUMENT ADDRESS 

GO TO SETUP 

CALL CARD READ ROUTINE 

READ 

AREA PARAMETER 

ERROR PARAMETER 

CALL CONVERSION ROUTINE 

CARD CODE TO EBCDIC 

FROM AREA 

TO JCARD JLAST 

CHARACTER COUNT 

ERROR INDICATOR 

ALL DONE IF ZERO 

CLEAR ACC 

CLEAR THE INDICATOR 

CONVERT AGAIN 

REVERSE THE ARRAY 

FROM JCARD J 

TO JCARD JLAST 

CALL BUSY TEST ROUTINE 

BUSY TEST PARAMETER 

REPEAT IF BUSY 

INCREMENT 4 ARGUMENTS 

STORE IR1 

RESTORE IR1 

RETURN TO CALLING PROGRAM 

START OF ERROR ROUTINE 

STORE ACC IN ERROR WORD 

SET THE FLAG INDICATOR 

RETURN TO INTERRUPT PROGRM 

START OF SETUP ROUTINE 

CALL ARGS SUBPROGRAM 

GET JCARD J ADDRESS 

GET JCARD JLAST ADDRESS 

GET CHARACTER COUNT 

MAX CHARACTER COUNT 

DISTRIBUTE JCARD JLAST 

INTO JLAS2 



CSP21460 
CSP21470 
CSP21480 
CSP21490 
CSP21500 
CSP21510 
CSP21520 
CSP21530 
CSP21540 
CSP21550 
CSP21560 
CSP21570 
CSP21580 
CSP21590 
CSP21600 
CSP21610 
CSP21620 
CSP21630 
CSP21640 
CSP21650 
CSP21660 
CSP21670 
CSP21680 
CSP21690 
CSP21700 
CSP21710 
CSP21720 
CSP21730 
CSP21740 
CSP21750 
CSP21760 
CSP21770 
CSP21780 
CSP21790 
CSP21800 
C5P21810 
CSP21820 
CSP21830 
CSP21840 
CSP21850 
CSP21860 
CSP21870 
CSP21880 
CSP21890 
CSP21900 
CSP21910 
CSP21920 
CSP21930 
CSP21940 
CSP21950 
CSP21960 
CSP21970 
CSP21980 
CSP21990 
CSP22000 
CSP22010 
CSP22020 



0082 01 


C4000001 


LD 


L AREA 


0084 


DODB 


STO 


CNT1 


0065 


D012 


STO 


CNT2 


0086 


C103 


LD 


1 3 


0087 


DOED 


STO 


ERR&l 


0088 


1610 


SRA 


16 


0089 


DOCS 


STO 


FLAG 


008A 01 


4C80007A 


BSC 


I SETUP 


008C 


0000 


PUNCH DC 


*-# 


008D 


69E2 


STX 


1 SAVE1&1 


008E 01 


6580008C 


LDX 


11 PUNCH 


0090 


40E9 


BSI 


SETUP 


0091 20 


22989547 


Cf t lL vLIBF; 


SWING 


0092 1 


0000 


DC ' 


JCARD 


0093 1 


O05F 


DC 


JLAS1 


0094 20 


225C5144 


LIBF 


SPEED 


0095 


0011 


DC 


/ooii 


0096 


0000 


JLAS2 DC 


»-# 


0097 1 


0002 


DC 


AREA&l 


0098 


0000 


CNT2 DC 


«-* 


0099 20 


03059131 


LIBF 


CARD1 


009A 


2000 


DC 


/2000 


009B 1 


0001 


DC 


AREA 


009C 1 


0073 


DC 


ERROR 


009D 


70C9 


MDX 


FINAL 


009E 




END 





DISTRIBUTE COUNT 

INTO CNT1 

AND CNT2 

GET ERROR WORD ADDRESS 

STORE INSIDE ERROR ROUTINE 

CLEAR ACC 

CLEAR ERROR INDICATOR 

RETURN TO CALLING PROG 

PUNCH ROUTINE STARTS HERE 

SAVE IR1 

LOAD 1ST ARGUMENT ADDRESS 

GO TO SETUP ROUTINE 

CALL REVERSE ARRAY 

FROM JCARD J 

TO JCARD JLAST 

CALL CONVERSION ROUTINE 

FROM EBCDIC TO CARD CODE 

FROM JCARD JLAST 

TO THE I/O AREA BUFFER 

CHARACTER COUNT 

CALL PUNCH ROUTINE 

PUNCH 

I/O AREA BUFFER 

ERROR PARAMETER 

ALL THROUGH* GO TO FINAL 

END OFCREAD SUBPROGRAM 
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CSP22030 
CSP22040 
CSP22050 
CSP22060 
CSP22070 
CSP22080 
CSP22090 
CSP22100 
CSP22110 
CSP22120 
CSP22130 
CSP22140 
CSP22150 
CSP22160 
CSP22170 
CSP22180 
CSP22190 
CSP22200 
CSP22210 
CSP22220 
CSP22230 
CSP22240 
CSP22250 
CSP22260 
CSP22270 
CSP22280 



NO ERRORS IN ABOVE ASSEMBLY. 



// DUP 
•STORE 
33B3 0006 



WS UA CREAD 



CSP22290 
CSP22300 



184- 



// ASM 














CSP22310 


•« READ 


SUBROUTINE 


FOR 1130 CSPt ; 


2501 


(ID) 


CSP22320 


• NAME 1 


32501 










(ID) 


CSP22330 


* LIST 














CSP22340 


0053 


19CB5C31 




ENT 




R2501 


SUBROUTINE ENTRY POINT 


CSP22350 






» CALL R250KJCARD. Jt 


JLAST. NERR1) 


CSP22360 






* READ COLUMNS FROM BEGINNING OF CARD INTO JCARD(J) 


CSP22370 






• THROUGH JCARO(JLAST) 


• PUT ERROR PARAMETER IN 


CSP22380 






* NERR1. 








CSP22390 


0000 


0000 


JCARD 


DC 




•-* 


JCARD J ADDRESS 


CSP22400 


0001 


0051 


AREA 


BSS 




81 


I/O AREA BUFFER 


CSP22410 


0052 


0000 


FLAG 


DC 




#-# 


ERROR INDICATOR 


CSP22420 


0053 


0000 


R2501 


DC 




«-« 


FIRST ARGUMENT ADDRESS 


CSP22430 


0054 


692C 




STX 


1 


SAVE161 


SAVE IR1 


CSP22440 


0055 01 


65800053 




LDX 


11 


R2501 


GET 1ST ARGUMENT ADDRESS 


CSP22450 


0057 20 


01647880 




LIBF 




ARGS 


CALL ARGS SUBPROGRAM 


CSP22460 


0058 1 


0000 




DC 




JCARD 


GET JCARD J ADDRESS 


CSP22470 


0059 1 


0072 




DC 




JLAS1 


GET JCARD JLAST ADDRESS 


CSP22480 


005A 1 


0001 




DC 




AREA 


GET CHARACTER COUNT 


CSP22490 


005B 


0050 




DC 




80 


MAX CHARACTER COUNT 


CSP22500 


005C 


C0A4 




LD 




AREA 


DISTRIBUTE COUNT 


CSP22510 


0050 


D015 




STO 




CNT1 


INTO CNT1 


CSP22520 


005E 


C103 




LD 


1 


3 


GET ERROR WORD ADDRESS 


CSP22530 


005F 


0026 




STO 




ERR&l 


STORE INSIDE ERROR ROUTINE 


CSP22540 


0060 


1810 




SRA 




16 


CLEAR ACC 


CSP22550 


0061 


DOFO 




STO 




FLAG 


CLEAR ERROR INDICATOR 


CSP22560 


0062 


7104 




MDX 


1 


4 


INCREMENT 4 ARGUMENTS 


CSP22570 


0063 


691F 




STX 


1 


DONE&l 


STORE IR1 


CSP22580 


0064 


C026 




LD 




ONE SET 


AREA TO ALL ONES 


CSP22590 


0065 00 


65000050 




LDX 


LI 


80 LOAD IR1 WITH AREA SUE 


CSP22600 


0067 01 


05000001 


MO 


STO 


LI 


AREA STORE A ONE IN AREA 


CSP22610 


0069 


71FF 




MDX 


1 


-1 GO 


TO NEXT WORD OF AREA 


CSP22620 


006A 


70FC 




MDX 




MO GO 


BACK UNTIL FINISHED 


CSP22630 


006B 20 


19141131 




LIBF 




READ1 


CALL CARD READ ROUTINE 


CSP22640 


006C 


1000 




DC 




/1000 


READ 


CSP22650 


0060 1 


0001 




DC 




AREA 


AREA PARAMETER 


CSP22660 


006E 1 


0084 




DC 




ERROR 


ERROR PARAMETER 


CSP22670 


006F 20 


225C5144 


CONVT 


LIBF 




SPEED 


CALL CONVERSION ROUTINE 


CSP22680 


0070 


0010 




DC 




/ooio 


CARD CODE TO EBCDIC 


CSP22690 


0071 1 


0002 




DC 




AREA&l 


FROM AREA 


CSP22700 


0072 


0000 


JLAS1 


DC 




*-* 


TO JCARD JLAST 


CSP22710 


,0073 


0000 


CNT1 


DC 




«-• 


CHARACTER COUNT 


CSP22720 


0074 


CODD 




LD 




FLAG 


ERROR INDICATOR 


CSP22730 


0075 01 


4C18007A 




BSC 


L 


FINAL. 6- 


ALL DONE IF ZERO 


CSP22740 


0077 


1810 




SRA 




16 


CLEAR ACC 


CSP22750 


0078 


D0D9 




STO 




FLAG 


CLEAR THE INDICATOR 


CSP22760 


0079 


70F5 




MDX 




CONVT 


CONVERT AGAIN 


CSP22770 


007A 20 


22989547 


FINAL 


LIBF 




SWING 


REVERSE THE ARRAY 


CSP22780 


007B 1 


0000 




DC 




JCARD 


FROM JCARD J 


CSP22790 


J007C 1 


0072 




DC 




JLAS1 


TO JCARD JLAST 


CSP22800 


007D 20 


19141131 


TEST 


LIBF 




READ1 


CALL BUSY TEST ROUTINE 


CSP22810 


007E 


0000 




DC 




/oooo 


BUSY TEST PARAMETER 


CSP22820 


007F 


70FD 




MDX 




TEST 


REPEAT IF BUSY 


CSP22830 


0080 00 


65000000 


SAVE1 


LDX 


LI 


»-# 


RESTORE IR1 


CSP22840 


0082 00 


4C000000 


DONE 


BSC 


L 


«-* 


RETURN TO CALLING PROGRAM 


CSP22850 


0084 


0000 


ERROR 


DC 




»-* 


START OF ERROR ROUTINE 


CSP22860 


0085 00 


04000000 


ERR 


STO 


L 


»-# 


STORE ACC IN ERROR WORD 


CSP22870 



0087 01 74010052 




MDX 


L 


0089 01 4C800084 




BSC 


I 


008B 0001 


ONE 


DC 




008C 




END 
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FLAG.l SET THE FLAG INDICATOR CSP22880 

ERROR RETURN TO INTERRUPT PROGRM CSP22890 

1 CONSTANT OF ONE CSP22900 

END OF R2501 SUBPROGRAM CSP22910 



NO ERRORS IN ABOVE ASSEMBLY. 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DW 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



// DUP 
•STORE 
33B9 0005 



WS UA R2501 



CSP22920 
CSP22930 



// ASM 

•• STACKER SELECT 

• NAME STACK 

* LIST 

0002 228C10D2 



EAT 



0000 


0000 


IOCC DC 


0001 


1480 


DC 


0002 


0000 


STACK DC 


0003 


08FC 


XIO 


0004 01 


4C800002 


BSC 


0006 




END 



CSP22940 
SUBROUTINE FOR 1130 COMMERCIAL SUBROUTINE PACKAGE(ID) CSP229S0 

(ID) CSP22960 
CSP22970 
STACK STACK SUBROUTINE POINT CSP229B0 

CALL STACK CSP22990 

SELECTS THE NEXT CARD THROUGH CSP230O0 
THE PUNCH STATION TO THE CSP23010 
ALTERNATE STACKER ON THE 1442-5* CSP23020 
6»0R 7. CSP23030 

I/O COMMAND - FIRST WORD CSP23040 
/1480 I/O COMMAND - SECOND WORD CSP23050 
•-* RETURN ADDRESS COMES IN HERE CSP23060 
IOCC SELECT STACKER CSP23070 

I STACK RETURN TO CALLING PROG CSP23080 

CSP23090 



NO ERRORS IN ABOVE ASSEMBLY, 



-185- 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



// DUP 

•STORE WS UA STACK 

33BE 0002 



CSP23100 
CSP23110 



// ASH 

•• TYPE AND KEYBD SUBROUTINES FOR 1130 CSP 

* NAME TYPER 

* LIST 

003F 23A17159 



(ID) 
(ID) 



0000 

0001 
0002 
003F 

0040 

0041 

0042 

0043 01 
004$ 

0046 

0047 

0048 

0049 
004A 
004B 
004C 20 
004D 1 
004E 1 
004F 1 

0050 20 

0051 

0052 1 

0053 1 

0054 

0055 20 

0056 

0057 1 
0056 

0059 
005A 00 
005C 00 
005E 
005F 20 

0060 

0061 

0062 20 

0063 1 
0064 
0065 
0066 
0067 
0069 
006A 
006B 
006C 
006D 01 
006F 



12168084 



0001 

0000 

003D 

0000 

691A 

6178 

6923 

6580003F 

4018 

COBB 

80B8 

1801 

D0B8 

1001 

D008 

195C10D2 

0001 

0083 

0003 

05097663 

0000 

0003 

0003 

0000 

23A17170 

2000 

0002 

7103 

6903 

65000000 

4C00O0O0 

0000 

23A17170 

0000 

70FD 

01647880 

0001 

0083 

0002 

0000 

4C80005E 

0000 

69F0 

613C 

69F9 

65800069 

40EE 



ENT TYPER SUBROUTINE ENTRY POINT 
CALL TYPE (JCARD. Jt JLAST) 
TYPE JCARD(J) THROUGH JCARD(JLAST) 

ENT KEYBD SUBROUTINE ENTRY POINT 
CALL KEYBD (JCARDi J. JLAST) 
ENTER AT KEYBOARD JCARDU) THROUGH JCARD(JLAST) 



ONE DC 
JCARD DC 
AREA BSS 
TYP*R DC 
STX 
LDX 
STX 
LDX 
BSI 
LD 
A 

SRA 
STO 
SLA 
STO 
LIBF 
DC 
DC 
DC 

LIBF 
DC 
DC 
DC 
DC 
LIBF 
DC 
DC 
FINAL MDX 
STX 
SAVE1 LDX 
DONE BSC 
SETUP DC 
TEST LIBF 
DC 
MDX 
LIBF 
DC 
DC 
DC 
MAXCH DC 

BSC 
KEYBD DC 
STX 
LDX 
STX 
LDX 
BSI 



61 



CNT1 



1 SAVE1&1 
1 120 - 
1 MAXCH 
II TYPER 
SETUP 
AREA 
ONE 
1 

AREA 
1 

CNT1 
RPACK 
JCARD 
JLAST 
AREA&l 
EBPRT 
/OOOO 
AREA&l 
AREA&l 
#-» 
TYPEO 
/2000 
AREA 
1 3 

1 DONE&l 
LI #-# 



L #-# 

TYPEO 

/OOOO 

TEST 

ARCS 

JCARD 

JLAST 

AREA 

«-# 

I SETUP 
«-* 

1 SAVE1&1 
1 60 
1 MAXCH 

II KEYBD 
SETUP 



CONSTANT OF 1 

JCARD J ADDRESS 

I/O AREA BUFFER 

FIRST ARGUMENT ADDR HERE 

SAVE IR1 

PUT 120 IN IR1 

STORE IT AS MAX CHARS 

PUT FIRST ADDR IN IR1 

GO TO SETUP 

GET CHARACTER COUNT 

HALF ADJUST IT AND 

DIVIDE IT BY TWO 

AND REPLACE IT 

DOUBLE IT 

AND PUT IT IN CNT1 

CALL REVERSE PACK ROUTINE 

FROM JCARD J 

TO JCARD JLAST 

PACK INTO I/O AREA 

CALL CONVERSION ROUTINE 

FROM EBCDIC 

TO PRINTER CODE. 

ALL IN THE I/O AREA 

HALF ADJSTD CHARACTER CNT 

CALL TYPE ROUTINE 

TYPE PARAMETER 

I/O AREA BUFFER 

INCREMENT OVER 3 ARGUMENTS 

STORE IR1 

RESTORE IR1 

RETURN TO CALLING PROGRAM 

START OF SETUP ROUTINE 

CALL BUSY TEST ROUTINE 

BUSY TEST PARAMETER 

REPEAT TEST IF BUSY 

CALL ARGS ROUTINE 

1ST ARGUMENT TO JCARD J 

TO JCARD JLAST 

TO CHARACTER COUNT 

MAXIMUM NUMBER OF CHARS 

END OF SETUP. RETURN 

START OF KEYBOARD ROUTINE 

SAVE IR1 

PUT BUFFER LENGTH IN IR1 

60 IS MAX NO OF CHARS 

1ST ARGUMENT ADDR IN IR1 

GO TO SETUP 



CSP23120 
CSP23130 
CSP23140 
CSP23150 
CSP23160 
CSP23170 
CSP23180 
CSP23190 
CSP23200 
CSP23210 
CSP23220 
CSP23230 
CSP23240 
CSP23250 
CSP23260 
CSP23270 
CSP23280 
CSP23290 
CSP23300 
CSP23310 
CSP23320 
CSP23330 
CSP23340 
CSP23350 
CSP23360 
CSP23370 
CSP23380 
CSP23390 
CSP23400 
CSP23410 
CSP23420 
CSP23430 
CSP23440 
CSP23450 
CSP23460 
CSP23470 
CSP23480 
CSP23490 
CSP23500 
CSP23510 
CSP23520 
CSP23530 
CSP23540 
CSP23550 
CSP23560 
CSP23570 
CSP23580 
CSP23590 
CSP23600 
CSP23610 
CSP23620 
CSP23630 
CSP23640 
CSP23650 
CSP23660 
CSP23670 
CSP23680 
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0070 


613C 




LDX 


1 60 


PUT BUFFER LENGTH IN IR1 


CSP23690 


0071 


1810 




SRA 


16 


CLEAR THE ACC 


CSP23700 


0072 01 


D5000002 


CLEAR 


STO 


LI AREA 


CLEAR THE I/O BUFFER 


CSP23710 


0074 


71FF 




MDX 


1 -1 


DECREMENT IR1 


CSP23720 


0075 


70FC 




MDX 


CLEAR 


AND CONTINUE CLEARING 


CSP23730 


0076 01 


65800069 




LDX 


11 KEYBD 


1ST ARGUMENT ADDR IN IR1 


CSP23740 


0078 


C089 




LD 


AREA 


PUT CHARACTER COUNT 


CSP23750 


0079 


DOOA 




STO 


CNT2 


IN CNT2 


CSP23760 


007A 20 


23A17170 




LIBF 


TYPEO 


CALL KEYBOARD ROUTINE 


CSP23770 


007B 


1000 




DC 


/1000 


KEYBOARD PARAMETER 


CSP23780 


007C 1 


0002 




DC 


AREA 


I/O AREA BUFFER 


CSP23790 


007D 20 


23A17170 


TEST1 


LIBF 


TYPEO 


CALL BUSY TEST ROUTINE 


CSP23800 


007E 


0000 




DC 


/OOOO 


BUSY TEST PARAMETER 


CSP23810 


007F 


70FD 




MDX 


TEST1 


REPEAT TEST IF BUSY 


CSP23820 


0080 20 


225C5144 




LIBF 


SPEED 


CALL CONVERSION ROUTINE 


CSP23B30 


0081 


0010 




DC 


/0010 


CARD CODE TO EBCDIC 


CSP23840 


0082 1 


0003 




DC 


AREA&l 


FROM THE I/O AREA BUFFER 


CSP23850 


0083 


0000 


JLAST 


DC 


•-* 


TO JCARD JLAST 


CSP23860 


0084 


0000 


CNT2 


DC 


*-# 


CHARACTER COUNT 


CSP23870 


0085 20 


22989547 




LIBF 


SWING 


CALL REVERSE ARRAY 


CSP23880 


0086 1 


0001 




DC 


JCARD 


REVERSE FROM JCARD J 


CSP23890 


0087 1 


0083 




DC 


JLAST 


TO JCARD JLAST 


CSP23900 


0088 


70CF 




MDX 


FINAL 


ALL THROUGH. GO TO FINAL 


CSP23910 


008A 






END 




END OF TYPE SUBPROGRAM 


CSP23920 



NO ERRORS IN ABOVE ASSEMBLY. 



186- 



// DUP 
♦STORE 
33C0 0006 



WS UA TYPER 



CSP23930 
CSP23940 



// ASM 

«» PACg/UNPAC SUBROUTINES FOR 

* LIST 

* NAME UNPAC 

0000 2*5570*3 ENT 



1130 COMMERCIAL SUBROUTINE PACKAGE 



(ID) 



0000 





0000 


UNPAC 


DC 




0001 





C003 




LO 




0002 





D01E 




STO 




0003 





7007 




MDX 




0004 


C 


7009 


SW1 


MDX 


X 


0005 





7000 


SW2 


MDX 


X 


0006 





0000 


PACK 


DC 




0007 





COFE 




LD 




0008 





D0F7 




STO 




0009 





COFA 




LD 




OOOA 





0016 




STO 




OOOB 





6930 


START 


STX 


1 


OOOC 


01 


65800000 




LDX 


11 


OOOE 





C100 




LD 


1 


OOOF 





8001 




A 




0010 


00 


95800001 


ONE 


S 


11 


0012 





DOOD 




STO 




0013 





C103 




LD 


1 


0014 





80FC 




A 


. 


0015 


00 


95800004 




S 


11 


0017 





0006 




STO 




0018 





C100 




LD 


1 


0019 





80F7 




A 




001A 


00 


95800002 




S 


11 


001C 





D0E9 




STO 




0010 


00 


65000000 


KCARD 


LDX 


LI 


00 IF 


00 


C4000000 


JCARD 


LD 


L 


0021 





7000 


SWTCH 


MDX 


X 


0022 





1888 




SRT 




0023 





1008 




SLA 




0024 





E81A 




OR 




0025 





D100 




STO 


1 


0026 





71FF 




MDX 


1 


0027 





1088 




SLT 




0028 





1008 




SLA 




0029 





E815 




OR 




002A 





7006 




MDX 




002B 





1898 


ELSE 


SRT 




002C 


01 


74FF0020 




MDX 


L 


002E 


01 


C4800020 




LD 


I 


0030 





18C8 




RTE 




0031 





D100 


FINIS 


STO 


1 


0032 


01 


74FF0020 




MDX 


L 



(ID) 
UNPAC UNPACK SUBROUTINE ENTRY POINT 
CALL UNPAC (JCARD. J .JLAST. KCARD. K) 
THE WORDS JCARD J THROUGH 
JCARD JLAST IN A2 FORMAT ARE 
UNPACKED INTO KCARD K IN Al FORMAT. 
PACW PACK SUBROUTINE ENTRY POINT 
CALL PACK(JCARD.J.JLAST.KCARD.K) 
THE WORDS JCARD J THROUGH 
JCARD JLAST IN Al FORMAT ARE PACKED 
INTO KCARD K IN A2 FORMAT. 
»-• ARGUMENT ADDRESS COMES IN HERE 
SW2 LOAD NOP INSTRUCTION 
SWTCH STORE NOP AT SWITCH 
START COMPUTING 
ELSE-SWTCH-1 BRANCH TO ELSE 
NOP INSTRUCTION 

*-♦ ARGUMENT ADDRESS COMES IN HERE 
PACK! PICK UP ARGUMENT ADDRESS 
UNPAC AND STORE IT IN UNPAC 
SW1 LOAD BRANCH TO ELSE 
SWTCH STORE BRANCH AT SWITCH 
SAVE161 SAVE IR1 
II UNPAC PUT ARGUMENT ADDRESS IN IR1 

GET JCARD ADDRESS 
ONE+1 ADD CONSTANT OF 1 

1 SUBTRACT J VALUE 
JCARD+1 CREATE JCARD(J) ADDRESS 

3 GET KCARD ADDRESS 
ONE+1 ADD CONSTANT OF 1 

4 SUBTRACT K VALUE 
KCARD+1 CREATE KCARD(K) ADDRESS 
GET JCARD ADDRESS 
ONE+1 ADD CONSTANT OF 1 

2 SUBTRACT JLAST VALUE 
PACj? CREATE JCARD JLAST ADDRESS 
*-* PUT KCARD ADDRESS IN IR1 
*-* PICK UP JCARDU) 
SWITCH BETWEEN PACK AND UNPACK 
8 SHIFT LOW ORDER BITS TO EXT 
8 REPOSITION HIGH ORDER BITS 
BMASK PUT BLANK IN LOW ORDER BITS 
PUT IN KCARD K 
-1 DECREMENT KCARD ADDRESS 
8 MOVE THE EXTEN INTO THE ACCUM 
8 IN TWO STEPS 

BMASK PUT BLANK IN LOW ORDER BITS 
FINIS BRANCH AROUND PACK ROUTINE 
24 SHIFT HIGH ORDER BITS INTO EXT 
JCARD+l.-l DECREMENT JCARD ADDRESS 
JCARD+1 PICK UP JCARDU+1) 
8 SHIFT IN BITS FROM EXT 
PUT IN KCARD K 
JCARD+l.-l DECREMENT JCARD ADDRESS 



CSP23950 
CSP23960 
CSP23970 
CSP23980 
CSP23990 
CSP24000 
CSP24010 
CSP24020 
CSP24030 
CSP24040 
CSP24050 
CSP24060 
CSP24070 
CSP24080 
CSP24090 
CSP24100 
CSP24110 
CSP24120 
CSP24130 
CSP24140 
CSP24150 
CSP24160 
CSP24170 
CSP24180 
CSP24190 
CSP24200 
CSP24210 
CSP24220 
CSP24230 
CSP24240 
CSP24250 
CSP24260 
CSP24270 
CSP24280 
CSP24290 
CSP243C0 
CSP24310 
CSP24320 
CSP24330 
CSP24340 
CSP24350 
CSP24360 
CSP24370 
CSP24380 
CSP24390 
CSP24400 
CSP24410 
CSP24420 
CSP24430 
CSP24440 
CSP24450 
CSP24460 
CSP24470 
CSP24480 
CSP24490 
CSP24500 
CSP24510 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



0034 71FF 






MDX 


0035 COEA 






LD 


0036 90CF 






S 


0037 01 4C10001F 






BSC L 


0039 01 74050000 






MDX L 


003B 00 65000000 


SAVE1 


LDX l: 


0C3D 01 4C800000 






BSC I 


003F 0040 


BMASK 


DC 


0040 






END 


NO ERRORS IN 


ABOVE 


ASSEMBLY. 



-1 DECREMENT KCARD ADDRESS 
JCARD+1 GET JCARDU) ADDRESS 
PACfc SUBTRACT JCARD JLAST ADDRESS 
JCARD.- CONTINUE IF DIFFERENCE 6 OR 
UNPAC .5 CREATE RETURN ADDRESS 
LI *-» RESTORE IR1 

UNPAC RETURN TO CALLING PROGRAM 
/40 MASK 00O0OOO0O1OOQ0OO 
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CSP24520 
CSP24530 
CSP24540 
CSP24550 
CSP24560 
CSP24570 
CSP24580 
CSP24590 
CSP24600 



// DUP 
•STORE 
33C6 0005 



WS UA UNPAC 



CSP24610 
CSP24620 
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ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



// ASM 












*• WHOLE NUMBER SUBROUTINE FOR 


1130 COMMERCIAL SUBROUTINE PACKAGE (ID) 


* NAME 


WHOLE 








(ID) 


* LIST 












0006 




262164C5 




ENT 


WHOLE 


SUBROUTINE ENTRY POINT 








• X«WH0LE(Y) f WITH Y IN 


FAC TO START 








# X IN FAC 


BECOMES THE 


INTEGRAL PART OF Y. 


0000 





0000 


DBLl 


D £ 





DBL CONSTANT OF 1 


0001 





0001 




ofc 


1 


REST OF DBLl CONSTANT 


001F 






MANT 


EQU 


31 


MANTISSA LENGTH 


0002 





009F 


C159 


DC 


128+MANT 


EXPONENT OF FULL INTEGER 


0003 





001F 


C31 


DC 


MANT 


MANTISSA LENGTH 


0004 





189F 


SRT 


SRT 


MANT 


SRT MANTISSA LENGTH 


0005 





0800 


H0800 


DC 


/0800 


DIFF BETWEEN SRT AND SLT 


0006 





0000 


WHOLE 


DC 


#-# 


ARGUMENT ADDRESS HERE 


0007 





COFA 




LD 


C159 


EXP OF FULL INTEGER 


0008 





9370 




S 


3 125 


SUBTRACT EXP OF Y 


0009 


01 


4C2B001A 




BSC 


L DONE » +2 


BRANCH IF ALL INTEGER 


000B 





90F7 




S 


C31 


SUBTRACT MANTISSA LENGTH 


oooc 


01 


4C10001E 




BSC 


L FRACT»- 


BRANCH IF ALL FRACTIONAL 


000E 





80F5 




A 


SRT 


CREATE RIGHT SHIFT 


000F 





0005 




STO 


RIGHT 


STORE RIGHT SHIFT 


0010 





90F4 




S 


H0800 


CREATE LEFT SHIFT 


0011 





0006 




STO 


LEFT 


STORE LEFT SHIFT 


0012 





CB7E 




LOD 


3 126 


PICK UP MANTISSA 


0013 





4828 




BSC 


+Z 


CHECK FOR NEGATIVE MANTISA 


0014 





98EB 




SO 


DBLl 


SUBTRACT 1 IF NEGATIVE 


0015 





1880 


RIGHT 


SRT 


•-# 


RIGHT SHIFT 


0016 





4828 




BSC 


+Z 


CHECK FOR NEGATIVE MANTISA 


0017 





88E8 




AD 


DBLl 


ADD 1 IF NEGATIVE 


0018 





1080 


LEFT 


SLT 


#-# 


LEFT SHIFT 


0019 





DB7E 


STORE 


STD 


3 126 


STORE MANTISSA 


001A 


01 


74010006 


DONE 


MDX 


L WHOLE »1 


CREATE RETURN ADDRESS 


001C 


01 


4C800006 




BSC 


I WHOLE 


RETURN TO CALLING PROGRAM 


001E 





10E0 


FRACT 


SLC 


32 


ZERO ACC AND EXT 


001F 





0370 




STO 


3 125 


ZERO THE EXPONENT 


0020 





70F8 




MDX 


STORE 


ZERO THE MANTISSA 


0022 








END 




END OF WHOLE SUBROUTINE 



CSP24630 
CSP24640 
CSP24650 
CSP24660 
CSP24670 
CSP24680 
CSP24690 
CSP24700 
CSP24710 
CSP24720 
CSP24730 
CSP24740 
CSP24750 
CSP24760 
CSP24770 
CSP24780 
CSP24790 
CSP24800 
CSP24810 
CSP24820 
CSP24830 
CSP24840 
CSP24850 
CSP24860 
CSP24870 
CSP24880 
CSP24890 
CSP24900 
CSP24910 
CSP24920 
CSP24930 
CSP24940 
CSP24950 
CSP24960 
CSP24970 
CSP24980 
CSP24990 
CSP25000 



NO ERRORS IN ABOVE ASSEMBLY. 



// DUP 
•STORE 
33CB 0003 



WS UA WHOLE 



CSP25010 
CSP25020 
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// ASM 














CSP25030 


»» ARGS, 


i RPACK AND 


SWING 


SUBROUTINES FOR 1130 CSP (ID) 


CSP25040 


* LIST 














CSP25050 


* NAME ARGS 










(ID) 


CSP25060 








-LI BR- 




L1BF -T YP E- ROUT I N E S- FOLLOW 


CSP25070 






• THESE SUBROUTINES CANNOT BE CALLED FROM FORTRAN 


CSP25080 


0002 


01647880 




ENT 




ARGS 


SUBROUTINE ENTRY POINT 


CSP25090 






• ARGS GETS THE ARGUMENT 


FOR THE I/O ROUTINES 


CSP25100 


0030 


195C10D2 




ENT 




RPACK 


SUBROUTINE ENTRY POINT 


CSP25U0 






* RPACK REVERSES AND PACKS EBCDIC STRINGS 


CSP25120 


004F 


22989547 




ENT 




SWING 


SUBROUTINE ENTRY POINT 


CSP25130 




0001 


*_SWING REVERSES AN EBCD 
ONE DC 1 


IC STRING 


CSP25140 


0000 


CONSTANT OF ONE ' 


""CSP25150" 


0001 


0000 


JLAST 


DC 




»-» 


JCARD (JLAST) ADDRESS 


CSP25160 


0002 


6A2A 


ARGS 


STX 


2 


SAVE2&1 


ARGS ROUTINE STARTS HERE 


CSP25170 


0003 00 


66800000 




LDX 


12 





GET 1ST ARGUMENT ADDR 


CSP25180 


0005 


C100 




LD 


1 





GET JCARD ADDR 


CSP25190 


0006 00 


95800002 




S 


11 


2 


SUBTRACT JLAST VALUE 


CSP25200 


0008 


80F7 




A 




ONE 


ADD ONE 


CSP25210 


0009 00 


D6800001 




STO 


12 


1 


STORE IN 2ND ARG 


CSP25220 


000B 


C100 




LD 


1 





GET JCARD ADDR 


CSP25230 


OOOC 00 


95800001 




S 


11 


1 


SUBTRACT J VALUE 


CSP25240 


OOOE 


80F1 




A 




ONE 


ADD ONE 


CSP25250 


OOOF 00 


06800000 




STO 


12 





STORE IN 1ST ARG 


CSP25260 


0011 00 


96800001 




S 


12 


1 


SUBTRACT JLAST ADDR 


CSP25270 


0013 


80EC 




A 




ONE 


ADD ONE 


CSP25280 


0014 01 


4C08001B 




BSC 


L 


ER0R1.+ 


CHECK FOR NEG OR CHARS 


CSP25290 


0016 


9203 




S 


2 


3 


OK. SUBTRACT MAX CHARS 


CSP25300 


0017 01 


4C300021 




BSC 


L 


ERROR. -Z 


CHECK MORE THAN MAX CHARS 


CSP25310 


0019 


8203 




A 


2 


3 


ADD MAX CHARS BACK 


CSP25320 


001A 


700D 




MDX 




OK 


ADDRESSES OK 


CSP25330 


001B 00 


C6800000 


ERO«U 


LD 


12 





PICK UP JCARD(J) 


CSP25340 


001D 00 


D6800001 




STO 


12 


1 


AND STORE IN JCARD (JLAST) 


CSP25350 


001F 


COEO 




LD 




ONE 


SET UP CHAR COUNT OF 1 


CSP25360 


0020 


7007 




MDX 




OK 


GO TO STORE CHAR COUNT 


CSP25370 


0021 00 


C6800000 


ERROR 


LD 


12 





PICK UP JCARD(J) 


CSP25380 


0023 


9203 




S 


2 


3 


AND CALCULATE JCARD (JLAST) 


CSP25390 


0024 


80DB 




A 




ONE 


TO BE JCARDU+MAX-1) 


CSP25400 


0025 00 


D6800001 




STO 


12 


1 


STORE ADDR IN JCARD(JLAST) 


CSP25410 


0027 


C203 




LD 


2 


3 


LOAD CHARACTER COUNT 


CSP25420 


0028 00 


D6800002 


OK 


STO 


12 


2 


STORE CHARACTER COUNT 


CSP25430 


002A 


7204 




MDX 


2 


4 


CREATE RETURN ADDR 


CSP25440 


002B 


6A03 


LAST 


STX 


2 


DONE&l 


STORE RETURN ADDRESS 


CSP25450 


002C 00 


66000000 


SAVE2 


LDX 


L2 


«-• 


RESTORE IR2 


CSP25460 


002E 00 


4COO0O00 


DONE 


BSC 


L 


*-* 


RETURN TO CALLING PROGRAM 


CSP25470 


0030 


6AFC 


RPACK 


STX 


2 


SAVE261 


RPACK ROUTINE STARTS HERE 


CSP25480 


0031 00 


66800000 




LDX 


12 





GET 1ST ARGUMENT ADDRESS 


CSP2549C 


0033 00 


C6SO0000 




LD 


12 





GET JCARD ADDR 


CSP25500 


0035 


0006 




STO 




JCARD&l 


INITIALIZE JCARD ADDRESS 


CSP25510 


0036 00 


C6800001 




LD 


12 


1 


GET SECOND ARGUMENT ADDR 


CSP25520 


0038 


DOCS 




STO 




JLAST 


INITIALIZE JCARD JLAST 


CSP25530 


0039 


C202 




LD 


2 


2 


GET AREA ADDRESS 


CSP25540 


003A 


D009 




STO 




KCARD&l 


INITIALIZE PACK TO ADDRESS 


CSP25550 


003B 00 


C4000000 


JCARD 


LD 


L 


#-* 


LOAD FIRST CHARACTER 


CSP25560 


003D 


1898 




SRT 




24 


SHIFT INTO EXT 


CSP25570 


003E 01 


74FF003C 




MDX 


L 


JCARD&l. -1 


DECREMENT ADDRESS 


CSP25560 


0040 01 


C480003C 




LD 


I 


JCARD&l 


GET SECOND CHARACTER 


CSP25590 



0042 


18C8 




RTE 




8 


0043 00 


D4000000 


KCARD 


STO 


L 


#-» 


0045 01 


74FF003C 




MDX 


L 


JCARD&l. -1 


0047 01 


74010044 




MDX 


L 


KCARD&l. &1 


0049 


C0F.2 




LD 




JCARD&l 


004A 


90B6 




S 




JLAST 


004B 01 


4C10003B 




BSC 


L 


JCARD. - 


004D 


7203 




MDX 


2 


3 


004E 


70DC 




MDX 




LAST 


004F 


6ADD 


SWING 


STX 


2 


SAVE2&1 


0050 00 


66800000 




LDX 


12 





0052 00 


C6800000 




LD 


12 





0054 


D007 




STO 




BACK&l 


0055 00 


C6800001 




LD 


12 


1 


0057 


D001 




STO 




FRONT&l 


0058 00 


C4000000 


FRONT 


LD 


L 


«-• 


005A 


1890 




SRT 




16 


005B 00 


C4000000 


BACK 


LD 


L 


*-» 


005D 


E810 




OR 




HEX40 


005E 01 


D4800059 




STO 


I 


FRONT&l 


0060 


1090 




SLT 




16 


0061 


E80C 




OR 




HEX40 


0062 01 


D480005C 




STO 


I 


BACK&l 


0064 01 


74010059 




MDX 


L 


FRONT&l. &1 


0066 01 


74FF005C 




MDX 


L 


BACK&l .-1 


0068 


COFO 




LO 




FRONT&l 


0069 


90F2 




S 




BACK+1 


006A Ql 


4C080058 




BSC 


L 


FRONT ♦& 


006C 


7202 




MDX 


2 


2 


006D 


70BD 




MDX 




LAST 


006E 


0040 


HEX40 


DC 




/0040 


0070 






END 







SHIFT RIGHT. RETRIEVE EXT 
STORE IN AREA 
DECREMENT ADDRESS 
INCREMENT AREA ADDRESS 
GET ENDING ADDRESS 
SUBTRACT JCARD JLAST ADDR 
REPEAT IF NOT MINUS 
INCREMENT OVER 3 ARGS 
ALL THROUGH. GO TO LAST 
SWING ARRAY END FOR END 
GET 1ST ARGUMENT ADDRESS 
GET FIRST ARGUMENT 
STORE AT BACK ADDRESS 
GET 2ND ARGUMENT 
STORE AT FRONT ADDRESS 
GET WORD FROM FRONT 
PUT IT IN THE EXT 
GET A WORD FROM THE BACK 
OR IN AN EBCDIC BLANK 
PUT IT IN THE FRONT 
RETRIEVE THE EXT 
OR IN AN EBCDIC BLANK 
PUT IT IN THE BACK 
INCREMENT THE FRONT ADDR 
DECREMENT THE BACK ADDR 
GET THE FRONT ADDRESS 
SUBTRACT THE BACK ADDRESS 
REPEAT IF MINUS 
INCREMENT OVER 2 ARGS 
ALL THROUGH. GO TO LAST 
EBCDIC BLANK CODE 
END OF ARGS SUBPROGRAM 
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CSP25600 
CSP25610 
CSP25620 
CSP25630 
CSP25640 
CSP25650 
CSP25660 
CSP25670 
CSP25680 
CSP25690 
CSP25700 
CSP25710 
CSP25720 
CSP25730 
CSP25740 
CSP25750 
CSP25760 
CSP25770 
CSP25780 
CSP25790 
CSP25800 
CSP25810 
CSP25820 
CSP25830 
CSP25840 
CSP25850 
CSP25860 
CSP25870 
CSP25880 
CSP25890 
CSP25900 
CSP25910 



ADD 

A1A3 

A1DEC 

A3A1 

CARRY 

DECA1 

DIV 

DPACK 

DUNPK 

EDIT 

FILL 

GET 

ICOMP 

IOND 

KEYBD 

MOVE 

MPY 

NCOMP 

NSIGN 

NZONE 

PACK 

PRINT 

PUNCH 

PUT 

P1403 

P1442 

READ 

R2501 

SKIP 

STACK 

SUB 

S1403 

TYPER 

UNPAC 

WHOLE 



NO ERRORS IN ABOVE ASSEMBLY. 



// DUP 
•STORE 
33CE 0008 



WS UA ARGS 



CSP25920 
CSP25930 
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APPENDIX 

CORE ALLOCATION 

To calculate the core requirements, sum the number of words for all routines used. If 
NZONE, CARRY, NSIGN, SERVICE, WHOLE, ADD, and/or FILL are not included in the 
first sum, and they are CALLed by a routine in the first sum, add their number of words 
to the first sum. Then calculate the Reference core requirements. Keep in mind that no 
matter how many times a Reference is used, it should be considered only once. Sum the 
core requirements of all References used. Add this sum to the first sum. The resulting 
total is the core requirement for the 1130 Commercial Subroutine Package. Notice that 
the FORTRAN subroutines a, b, and c will be used by most FORTRAN programs and so 
will be present whether the package is used or not. 
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Form H20-0241-3 
Revised 10/11/68 
ByTNLN20-1888 



CSP Routine Name 


Number of 
Words 


Calls These CSP 
Routines 


Calls These Subroutine 
Library Routines 


AIDEC 
A1A3/A3A1 
^ADD/SUB 
ARGS 


74 
152 
170 
112 


NZONE 
CARRY, FILL 


- 


CARRY 
DECAl 
DIV 
^DPACK/DUNPK 


54 

76 

238 

100 


NZONE 
CARRY, FILL 


- 


EDIT 
FILL 
GET 
rCOMP 


204 
30 
96 

122 


NZONE, FILL 
NZONE 


ref. a 


;<iond 

MOVE 

MPY 

NCOMP 


6 
36- 

164 
42 


CARRY, FILL 


- 


NSIGN 
NZONE 
PACK/UNPAC 
PRINT/SKIP 


42 

78 

66 

124 


ARGS 


ref. d 


PUT 

<P1403/S1403 
v'P1442 
CREAD/PUNCH 


104 
134 
130 
158 


NZONE, WHOLE 

ARGS 

ARGS 

ARGS 


ref. a and b 
ref. i 
ref. h 
ref. e and g 


R2501 
STACK 

TYPER/KEYBD 
WHOLE 


140 

6 

138 

34 


ARGS 
ARGS 


ref. c and g 
ref. f and g 



References 



a. (EADD,EMPY, ESTO, FLOAT, NORM, SNR, FARC, XMD) 450 words 

b. (EABS,IFIX) 74 words 

c. (READ1) 110 words 

d. (PRNT1) 404 words 

e. (CARD1) 264 words 

f. (TYPEO,EBPRT) 638 words 

g. (SPEED, ILS04) 360 words 
h. (PNCH1) 218 words 

i. (PRNT3,ZIPCO,EBPT3) 544 words 
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EBCDIC CHARACTERS AND DECIMAL EQUIVALENTS 



' A 


-16064 


S 


-7616 


blank 


16448 


B 


-15808 


T 


-7360 


. (period) 


19264 


C 


-15552 


U 


-7104 


< (less than) 


19520 


D 


-15296 


V 


-6848 


( 


19776 


E 


-15040 


w 


-6592 


+ 


20032 


F 


-14784 


X 


-6336 


& 


20544 


G 


-14528 


Y 


-6080 


$ 


23360 


H 


-14272 


Z 


-5824 


* 


23616 


'^ I 


-14016 





-4032 


) 


23872 


J 


-11968 


1 


-3776 


- (minus) 


24640 


K 


-11712 


2 


-3520 


/ 


24896 


L 


-11456 


3 


-3264 


» 


27456 


M 


-11200 


4 


-3008 


% 


27712 


N 


-10944 


5 


-2752 


# 


31552 





-10688 


6 


-2496 


@ 


31808 


P 


-10432 


7 


-2240 


1 (apostrophe) 


32064 


Q 


-10176 


8 


-1984 


= 


32320 


R 


-9920 


9 


-1728 
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TIMING DATA 



Subprogram Name 


Approximate* Execution Time in Microseconds** 


GET 


2250 + 2190 C 


PUT 


3450 + 3090 C 


EDIT 


630 + 90 S + 180 M 


MOVE 


300 + 45 C 


FILL 


300 + 30 C 


WHOLE 


1400 


NCOMP 


250 + 75 C 


NZONE 


350 


ICO MP 


500 + 95 C 


NSIGN 


240 


ADD 


2160 + 216 L 


SUB 


2160 + 216 L 


MPY 


2400 + 120 P 


DIV 


4000 + Q (445 + 667 DIV) 


A1DEC 


700 + 54 A 


DECA1 


180 + 117 A 


A1A3 


470 + 1084 A 


A3A1 


545 + 156 A 


PACK 


360 + 63 A 


UNPAC 


420 + 66 A 


DPACK 


392D 


DUNPK 


360D 


C = Length of the field, in characters 


S = Length of the source field 


M = Length of the edit mask 


P = Length of the multiplier field x length of the multiplicand field (significant 


digits only — don't count leading zeros) 


A = Length of the Al field 


D = Length of the packed decimal (D4) field 


L = Length of the longer of the two fields (significant digits only — don T t count 


leading zeros) 


Q = Number of significant digits in the quotient (result) field 


DIV = Number of significant digits in the divisor (denominator) field 


* All timings are approximate, and are based on test runs of "typical" 


cases, using fields of "average" size, magnitude, etc. Unusual cases 


may (or may not) differ significantly from the timings obtained from the 


given equations. This is particularly true of the decimal arithmetic 


routines (ADD, SUB, MPY, DIV). 


** Based on 3. 6-microsecond CPU cycle speed. Multiply by 0. 6 to obtain 


timings on 2. 2-microsecond CPU. 
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This page intentionally left blank* 
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1130 Commercial Subroutine Package (1130-SE-25X), Version 3, Programmers Reference Card 

Format of Data 



Format of Commercial Subroutine Calls (and Parameters*) Page** Before 



After 



Comments on Parameters 



CO 

I 



♦ONE WORD INTEGERS 

♦EXTENDED PRECISION 

*IOCS(DISK) - 

CALL ADD(JCARD,J,JLAST,KCARD,K,KLAST, NER) 13 

CALLA1A3(JCARD,J,JLAST,KCARD,K,ICHAR) 15 

CALLA1DEC(JCARD,J,JLAST,NER) 18 

CALLA3A1(JCARD,J,JLAST,KCARD,K,ICHAR) 21 

CALL DECA1(JCARD,J,JLAST,NER) 2o 

CALL DIvgCARDJJLAS^KCARD^KLAS^NER) 28 

CALL DPACK(JCARD,J,JLAST,KCARD,K) -..-31 

CALL DUNPK(JCARD,J,JLAST,KCARD,K) 34 

CALL EDIT(JCARD,J,JLAST,KCARD,K,KLAST) --36 

CALLFILL(JCARD,J,JLAST,NCH) 41 

GET(JCARD,J,JLAST,SHIFT) 42 

ICOMPgCARD^jLAS^KCARD^KLAST) 45 

CALLIOND A7 

CALL KEYBD(JCARD,J,JLAST) 4 ° 

CALLMOVE(JCARD,J,JLAST,KCARD,K) - "'""„ 

CALLMPY(JCARD,J,JLAST,KCARD,K,KLAST,NER) 52 

NCOMP(JCARD,J,JLAST,KCARD,K) M 

CALLNSIGN(JCARD,J,NEWS,NOLDS) 5o 

CALL NZONE(JCARD,J,NEWZ,NOLDZ) 58 

CALLPACK(JCARD,J,JLAST,KCARD,K) 60 

CALLPRINT(JCARD,J,JLAST,NER) 62 

CALL PUNCH(JCARD,J,JLAST,NER) M 

CALLPUT(JCARD,J,JLAST,VAR,ADJST,N) 66 

CALLP1403(JCARD,J,JLAST,NER) 68 

CALLP1442(JCARD,J,JLAST,NER) 70 

CALLREAD(JCARD,J,JLAST,NER) 73 

CALLR2501(JCARD,J,JLAST,NER) 76 

CALLSKIP(N) 79 

CALLS1403(N) w 

CALL STACK 81 

CALL SUB(JCARD,J,JLAST,KCARD,K,KLAST,NER) 82 

CALLTYPER(JCARDJ,JLAST)- 86 

CALLUNPACgCARD,J,JLAST,KCARD,K) 89 

WHOLE(EXPRESSION) 91 



— — Must use for every CSP program 

— — Must use if GET or PUT is present 

— _ Only DISK can be specified for CSP I/O 

Dl — Dl Initialize NER to 0; error if NER=KLAST --- 

Al A3 You must define I CHAR array, and it must contain 40 characters 

Al ... Dl Initialize NER to 0; error if NEI^O 

A3 Al You must define ICHAR array, and it must contain 40 characters 

Dl — Al Initialize NER to 0; error if NER^O 

Dl Dl Initialize NER to 0; error if NER=KLAST 

Dl — D4 

D4 — Dl 

Al Al Control characters in mask are: bO. ,CR-*S 

Dec. Al See reverse side for decimal values for NCH 

Al Real*** SHIFT must be real, extended precision. (1 .0=no shift) 

Al -0+ Minus:JCARD<KCARD;Zero:JCARD=KCARD;Plus:JCARD>KCARD. 

None — None Use before PAUSE or STOP (Monitor Version 1 Only) 

Al Al Maximum of 60 Characters allowed 

Any Same 

Dl Dl Initialize NER to 0; error if NER=KU\ST 

Al — -0+ Minus:JCARD<KCARD;Zero:JCARD=KCARD;Plus:JCARD> KCARD. 

Dl Integer See reverse side for values for NEWS and NOLDS 

Al Integer See reverse side for values for NEWZ and NOLDZ 

Al — A2 

Al Al Initialize NER to 0; if NER=3, reached chan.9; if NER=4, reached chan. 12 

Al Al Initialize NER to -1; if NER=0, last card, if NER=1, feed or punch check- - 

Real*** Al VAR and ADJST must be real, extended precision 

Al — Al Initialize NER to 0; if NER=3, reached chan. 9; if NER=4, reached chan. 12 

Al — Al Initialize NER to -1; if NER=0, last card; if NER=1, feed or punch check -- 

Al — Al Initialize NER to -1; if NER=0, last card; if NER=1, feed or read check 

Al Al Initialize NER to -1; if NER=0, last card; if NER=1, feed or read check 

Dec. None See reverse side for functional values for N 

Dec. None See reverse side for functional values for N ■ 

None None 

Dl — Dl Initialize NER to 0; error if NER=KLAST 

Al Al See reverse side for values for functional characters 

A2 Al 

Real Real The expression must be "real" not "integer" . 



JO TJ 

TO O 



a x 



^ f— K) 

Z O 

22 °^ V 

OO no . , 

r*> W U» 



* All parameters required by each subroutine must be supplied. 

** Page Number in 1130 Commercial Subroutine Package (1 130-SE-25X), Version 3 Program Reference Manual (H20-0241-3) 

*** Must use extended precision in calling program. 
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FILL and 


NCOMP 








EBCDIC Char. 


Dec. Equiv. 


NSIGN -used with Dl fields 




Low 


(12-0) 


-16320 (1)(2) 










A 


-16064 


If NOLDS IS: 


Then sign was: 






B 


-15808 


+1 


positive 






C 


-15552 


-1 


negative 






D. 


-15296 










E 


-15040 










F 


-14784 


When NEWS is: 


Sign is set to: 






G 


-14528 


+1 


positive 






H 


-14272 





opposite of old sign 






1 


-14016 


-1 


negative 






(ii-o) 


-12224 (1)(2) 


NOLDS 


no change 






J 
K 
L 


-11968 










-11712 
-11456 


NZONE - used with Al fields 








M 


-11200 










N 


-10944 


If NOLDZ is: 
1 
2 


Then character was: 
A-l 






O 


-10688 






P 


-10432 


J-R 






Q 


-10176 


3 


S-Z 






R 


-9920 


4 


0-9 






S 


-7616 


more than 4 


special 






T 


-7360 






(J 


U 


-7104 






c 

3 


V 


-6848 


When NEWZ is: 


Character is set to: , 


5T 


w 


-6592 


1 


12 zone 


to 


X 


-6336 


2 


1 1 zone 


c 


Y 


-6080 


3 


zone 


Jj 


Z 


-5824 


4 


no zone 


a 






more than 4 


no change 


.E 




1 


-4032 
-3776 










13 


2 


-3520 


SKIP and SI 403 function 


Value for N 


13 


3 


-3264 










4 


-3008 


Immediate skip to channel 1 


12544 






5 


-2752 


Immediate skip to channel 2 


12800 






6 


-2496 


Immediate skip to channel 3 


13056 






7 


-2240 


Immediate skip to channel 4 


13312 






8 


-1984 


Immediate skip to channel 5 


13568 






9 


-1728 


Immediate skip to channel 6 
Immediate skip to channel 9 
Immediate skip to channel 12 


13824 
14592 
15360 






blank 


16448 


Immediate space of 1 space 


15616 






. (period) 


19264 


Immediate, space of 2 spaces 


15872 






<(less than) 


19520(1) 


Immediate space of 3 spaces 


16128 






( 


19776 


Suppress space after printing 









+ 


20032 


Normal spacing is one space after 


printing. 






& 

$ 


20544 
23360 














* 


23616 


TYPER function 


Decimal constant 






) 


23872 


in 


(J CARD) output area 






-(minus) 


24640 


Tabulate 


1344 






-V 


24896 


Shift to black 


5184 






/ 


27456 


Carrier return 


5440 


, 


% 


27712(1) 


Backspace 


5696 


High 


# 


31552(1) 


Line Feed 


9536 




@ 


31808(1) 


Shift to red 


13632 




1 (apostrophe) 


32064 










= 


32320 






*0 


) Not 


on 1 132 or 1403 Printers 


(2) Not 


on console typewriter 









2 KZZi 
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OPERATING INSTRUCTIONS 

The procedures set forth in IBM 1130 Card/Paper Tape Programming System Operators 
Guide (C26-3629) and in IBM 1130 DISK Monitor System Reference Manual (C26-3750 or 
C26-3717) should be followed to execute the sample problems and all user-written 
programs. 

Switch settings for the sample problems are as follows: 



Input 
Device 


Output 
Device 


Switches 





1 


2 


1442 


console printer 


down 


down 


down 


1442 


1132 


up 


down 


down 


1442 


1403 


up 


up 


down 


2501 


console printer 


down 


down 


up 


2501 


1132 


up 


down 


up 


2501 


1403 


up 


up 


up 



Make sure that the switches are set properly before the program begins. 

Note: Sample Problem 2 cannot be executed if Version 1 of the Monitor is being used. 
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HALT LISTING 

Conditions A and B (see list below) have the following meaning: 

A Device not ready. 

B Internal subroutine error. Rerun job. If error persists, verify that the sub- 
routine deck is accurate, using the listings in this manual. If the deck is the 
same, contact your local IBM representative. Save all output. 



IAR 



Accumulator (hex) 



41 


lxxO 


41 


lxxl 


41 


2xx0 


41 


2xxl 


41 


4xx0 


41 


4xxl 


41 


6xx0 


41 


6xxl 


41 


9xx0 


41 


9xxl 



Device 




Condition 


1442 Card Read Punch 


A 


1442 Card Read Punch 


B 


Console printer or 


keyboard 


A 


Console printer or 


keyboard 


B 


2501 Card Reader 




A 


2501 Card Reader 




B 


1132 Printer 




A 


1132 Printer 




B 


1403 Printer 




A 


1403 Printer 




B 
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